1#=======================================================================
2#    ____  ____  _____              _    ____ ___   ____
3#   |  _ \|  _ \|  ___|  _   _     / \  |  _ \_ _| |___ \
4#   | |_) | | | | |_    (_) (_)   / _ \ | |_) | |    __) |
5#   |  __/| |_| |  _|    _   _   / ___ \|  __/| |   / __/
6#   |_|   |____/|_|     (_) (_) /_/   \_\_|  |___| |_____|
7#
8#   A Perl Module Chain to faciliate the Creation and Modification
9#   of High-Quality "Portable Document Format (PDF)" Files.
10#
11#   Copyright 1999-2005 Alfred Reibenschuh <areibens@cpan.org>.
12#
13#=======================================================================
14#
15#   This library is free software; you can redistribute it and/or
16#   modify it under the terms of the GNU Lesser General Public
17#   License as published by the Free Software Foundation; either
18#   version 2 of the License, or (at your option) any later version.
19#
20#   This library is distributed in the hope that it will be useful,
21#   but WITHOUT ANY WARRANTY; without even the implied warranty of
22#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
23#   Lesser General Public License for more details.
24#
25#   You should have received a copy of the GNU Lesser General Public
26#   License along with this library; if not, write to the
27#   Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28#   Boston, MA 02111-1307, USA.
29#
30#   $Id: SynFont.pm,v 2.2 2008/08/10 14:43:08 areibens Exp $
31#
32#=======================================================================
33package PDF::API3::Compat::API2::Resource::Font::SynFont;
34
35BEGIN {
36
37    use utf8;
38    use Encode qw(:all);
39
40    use vars qw( @ISA $VERSION );
41    use PDF::API3::Compat::API2::Resource::Font;
42    use PDF::API3::Compat::API2::Util;
43    use PDF::API3::Compat::API2::Basic::PDF::Utils;
44    use Math::Trig;
45    use Unicode::UCD 'charinfo';
46
47    @ISA=qw(PDF::API3::Compat::API2::Resource::Font);
48
49    ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.2 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2008/08/10 14:43:08 $
50
51}
52no warnings qw[ deprecated recursion uninitialized ];
53
54=head1 NAME
55
56PDF::API3::Compat::API2::Resource::Font::SynFont - Module for using synthetic Fonts.
57
58=head1 SYNOPSIS
59
60    #
61    use PDF::API3::Compat::API2;
62    #
63    $pdf = PDF::API3::Compat::API2->new;
64    $sft = $pdf->synfont($cft);
65    #
66
67=head1 METHODS
68
69=over 4
70
71=cut
72
73=item $font = PDF::API3::Compat::API2::Resource::Font::SynFont->new $pdf, $fontobj, %options
74
75Returns a synfont object.
76
77=cut
78
79=pod
80
81Valid %options are:
82
83I<-encode>
84... changes the encoding of the font from its default.
85See I<perl's Encode> for the supported values.
86
87I<-pdfname>
88... changes the reference-name of the font from its default.
89The reference-name is normally generated automatically and can be
90retrived via $pdfname=$font->name.
91
92I<-slant>
93... slant/expansion factor (0.1-0.9 = slant, 1.1+ = expansion).
94
95I<-oblique>
96... italic angle (+/-)
97
98I<-bold>
99... embolding factor (0.1+, bold=1, heavy=2, ...).
100
101I<-space>
102... additional charspacing in em (0-1000).
103
104I<-caps>
105... create synthetic small-caps.
106
107=cut
108
109sub new
110{
111    my ($class,$pdf,$font,@opts) = @_;
112    my ($self,$data);
113    my %opts=@opts;
114    my $first=1;
115    my $last=255;
116    my $slant=$opts{-slant}||1;
117    my $oblique=$opts{-oblique}||0;
118    my $space=$opts{-space}||'0';
119    my $bold=($opts{-bold}||0)*10; # convert to em
120
121    $self->{' slant'}=$slant;
122    $self->{' oblique'}=$oblique;
123    $self->{' bold'}=$bold;
124    $self->{' boldmove'}=0.001;
125    $self->{' space'}=$space;
126
127    $class = ref $class if ref $class;
128    $self = $class->SUPER::new($pdf,
129        pdfkey()
130        .'+'.($font->name)
131        .($opts{-caps} ? '+Caps' : '')
132        .($opts{-vname} ? '+'.$opts{-vname} : '')
133    );
134    $pdf->new_obj($self) unless($self->is_obj($pdf));
135    $self->{' font'}=$font;
136    $self->{' data'}={
137        'type' => 'Type3',
138        'ascender' => $font->ascender,
139        'capheight' => $font->capheight,
140        'descender' => $font->descender,
141        'iscore' => '0',
142        'isfixedpitch' => $font->isfixedpitch,
143        'italicangle' => $font->italicangle + $oblique,
144        'missingwidth' => $font->missingwidth * $slant,
145        'underlineposition' => $font->underlineposition,
146        'underlinethickness' => $font->underlinethickness,
147        'xheight' => $font->xheight,
148        'firstchar' => $first,
149        'lastchar' => $last,
150        'char' => [ '.notdef' ],
151        'uni' => [ 0 ],
152        'u2e' => { 0 => 0 },
153        'fontbbox' => '',
154        'wx' => { 'space' => '600' },
155    };
156
157    if(ref($font->fontbbox))
158    {
159        $self->data->{fontbbox}=[ @{$font->fontbbox} ];
160    }
161    else
162    {
163        $self->data->{fontbbox}=[ $font->fontbbox ];
164    }
165    $self->data->{fontbbox}->[0]*=$slant;
166    $self->data->{fontbbox}->[2]*=$slant;
167
168    $self->{'Subtype'} = PDFName('Type3');
169    $self->{'FirstChar'} = PDFNum($first);
170    $self->{'LastChar'} = PDFNum($last);
171    $self->{'FontMatrix'} = PDFArray(map { PDFNum($_) } ( 0.001, 0, 0, 0.001, 0, 0 ) );
172    $self->{'FontBBox'} = PDFArray(map { PDFNum($_) } ( $self->fontbbox ) );
173
174    my $procs=PDFDict();
175    $pdf->new_obj($procs);
176    $self->{'CharProcs'} = $procs;
177
178    $self->{Resources}=PDFDict();
179    $self->{Resources}->{ProcSet}=PDFArray(map { PDFName($_) } qw[ PDF Text ImageB ImageC ImageI ]);
180    my $xo=PDFDict();
181    $self->{Resources}->{Font}=$xo;
182    $self->{Resources}->{Font}->{FSN}=$font;
183    foreach my $w ($first..$last)
184    {
185        $self->data->{char}->[$w]=$font->glyphByEnc($w);
186        $self->data->{uni}->[$w]=uniByName($self->data->{char}->[$w]);
187        $self->data->{u2e}->{$self->data->{uni}->[$w]}=$w;
188    }
189
190    if($font->isa('PDF::API3::Compat::API2::Resource::CIDFont'))
191    {
192      $self->{'Encoding'}=PDFDict();
193      $self->{'Encoding'}->{Type}=PDFName('Encoding');
194      $self->{'Encoding'}->{Differences}=PDFArray();
195      foreach my $w ($first..$last)
196      {
197          if(defined $self->data->{char}->[$w] && $self->data->{char}->[$w] ne '.notdef')
198          {
199            $self->{'Encoding'}->{Differences}->add_elements(PDFNum($w),PDFName($self->data->{char}->[$w]));
200          }
201      }
202    }
203    else
204    {
205      $self->{'Encoding'}=$font->{Encoding};
206    }
207
208    #use Data::Dumper;
209    #print Dumper($self->data);
210    my @widths=();
211    foreach my $w ($first..$last)
212    {
213        if($self->data->{char}->[$w] eq '.notdef')
214        {
215            push @widths,$self->missingwidth;
216            next;
217        }
218        my $char=PDFDict();
219        my $wth=int($font->width(chr($w))*1000*$slant+2*$space);
220        $procs->{$font->glyphByEnc($w)}=$char;
221        #$char->{Filter}=PDFArray(PDFName('FlateDecode'));
222        $char->{' stream'}=$wth." 0 ".join(' ',map { int($_) } $self->fontbbox)." d1\n";
223        $char->{' stream'}.="BT\n";
224        $char->{' stream'}.=join(' ',1,0,tan(deg2rad($oblique)),1,0,0)." Tm\n" if($oblique);
225        $char->{' stream'}.="2 Tr ".($bold)." w\n" if($bold);
226        # my $ci = charinfo($self->data->{uni}->[$w]);
227        my $ci={};
228  		if ($self->data->{uni}->[$w] ne '')
229  		{
230    		$ci = charinfo($self->data->{uni}->[$w]);
231  		}
232        if($opts{-caps} && $ci->{upper})
233        {
234            $char->{' stream'}.="/FSN 800 Tf\n";
235            $char->{' stream'}.=($slant*110)." Tz\n";
236            $char->{' stream'}.=" [ -$space ] TJ\n" if($space);
237            my $ch=$self->encByUni(hex($ci->{upper}));
238            $wth=int($font->width(chr($ch))*800*$slant*1.1+2*$space);
239            $char->{' stream'}.=$font->text(chr($ch));
240        }
241        else
242        {
243            $char->{' stream'}.="/FSN 1000 Tf\n";
244            $char->{' stream'}.=($slant*100)." Tz\n" if($slant!=1);
245            $char->{' stream'}.=" [ -$space ] TJ\n" if($space);
246            $char->{' stream'}.=$font->text(chr($w));
247        }
248        $char->{' stream'}.=" Tj\nET\n";
249        push @widths,$wth;
250        $self->data->{wx}->{$font->glyphByEnc($w)}=$wth;
251        $pdf->new_obj($char);
252    }
253
254    $procs->{'.notdef'}=$procs->{$font->data->{char}->[32]};
255    $self->{Widths}=PDFArray(map { PDFNum($_) } @widths);
256    $self->data->{e2n}=$self->data->{char};
257    $self->data->{e2u}=$self->data->{uni};
258
259    $self->data->{u2c}={};
260    $self->data->{u2e}={};
261    $self->data->{u2n}={};
262    $self->data->{n2c}={};
263    $self->data->{n2e}={};
264    $self->data->{n2u}={};
265
266    foreach my $n (reverse 0..255)
267    {
268        $self->data->{n2c}->{$self->data->{char}->[$n] || '.notdef'}=$n unless(defined $self->data->{n2c}->{$self->data->{char}->[$n] || '.notdef'});
269        $self->data->{n2e}->{$self->data->{e2n}->[$n] || '.notdef'}=$n unless(defined $self->data->{n2e}->{$self->data->{e2n}->[$n] || '.notdef'});
270
271        $self->data->{n2u}->{$self->data->{e2n}->[$n] || '.notdef'}=$self->data->{e2u}->[$n] unless(defined $self->data->{n2u}->{$self->data->{e2n}->[$n] || '.notdef'});
272        $self->data->{n2u}->{$self->data->{char}->[$n] || '.notdef'}=$self->data->{uni}->[$n] unless(defined $self->data->{n2u}->{$self->data->{char}->[$n] || '.notdef'});
273
274        $self->data->{u2c}->{$self->data->{uni}->[$n]}=$n unless(defined $self->data->{u2c}->{$self->data->{uni}->[$n]});
275        $self->data->{u2e}->{$self->data->{e2u}->[$n]}=$n unless(defined $self->data->{u2e}->{$self->data->{e2u}->[$n]});
276
277        $self->data->{u2n}->{$self->data->{e2u}->[$n]}=($self->data->{e2n}->[$n] || '.notdef') unless(defined $self->data->{u2n}->{$self->data->{e2u}->[$n]});
278        $self->data->{u2n}->{$self->data->{uni}->[$n]}=($self->data->{char}->[$n] || '.notdef') unless(defined $self->data->{u2n}->{$self->data->{uni}->[$n]});
279    }
280
281    return($self);
282}
283
284
285=item $font = PDF::API3::Compat::API2::Resource::Font::SynFont->new_api $api, $fontobj, %options
286
287Returns a synfont object. This method is different from 'new' that
288it needs an PDF::API3::Compat::API2-object rather than a PDF::API3::Compat::API2::PDF::File-object.
289
290=cut
291
292sub new_api
293{
294  my ($class,$api,@opts)=@_;
295
296  my $obj=$class->new($api->{pdf},@opts);
297
298  $api->{pdf}->new_obj($obj) unless($obj->is_obj($api->{pdf}));
299
300  $api->{pdf}->out_obj($api->{pages});
301  return($obj);
302}
303
3041;
305
306__END__
307
308=back
309
310=head1 AUTHOR
311
312alfred reibenschuh
313
314=head1 HISTORY
315
316    $Log: SynFont.pm,v $
317    Revision 2.2  2008/08/10 14:43:08  areibens
318    update dejavu to 2.25
319
320    Revision 2.1  2007/04/18 05:26:48  areibens
321    fixed unicode caos handling for some broken fonts having no unicode for a glyph
322
323    Revision 2.0  2005/11/16 02:18:14  areibens
324    revision workaround for SF cvs import not to screw up CPAN
325
326    Revision 1.2  2005/11/16 01:27:50  areibens
327    genesis2
328
329    Revision 1.1  2005/11/16 01:19:27  areibens
330    genesis
331
332    Revision 1.17  2005/06/17 19:44:03  fredo
333    fixed CPAN modulefile versioning (again)
334
335    Revision 1.16  2005/06/17 18:53:34  fredo
336    fixed CPAN modulefile versioning (dislikes cvs)
337
338    Revision 1.14  2004/12/29 01:13:21  fredo
339    documented -caps option
340
341    Revision 1.13  2004/12/16 00:30:54  fredo
342    added no warn for recursion
343
344    Revision 1.12  2004/11/29 10:00:54  fredo
345    added charspacer docs
346
347    Revision 1.11  2004/11/26 15:14:59  fredo
348    fixed docs
349
350    Revision 1.10  2004/11/26 15:10:38  fredo
351    added spacer mod option
352
353    Revision 1.9  2004/06/15 09:14:53  fredo
354    removed cr+lf
355
356    Revision 1.8  2004/06/07 19:44:43  fredo
357    cleaned out cr+lf for lf
358
359    Revision 1.7  2004/02/10 15:55:42  fredo
360    fixed glyph generation for .notdef glyphs
361
362    Revision 1.6  2004/02/01 22:06:26  fredo
363    beautified caps generation
364
365    Revision 1.5  2004/02/01 19:27:18  fredo
366    fixed width calc for caps
367
368    Revision 1.4  2004/02/01 19:04:31  fredo
369    added caps capability
370
371    Revision 1.3  2003/12/08 13:06:01  Administrator
372    corrected to proper licencing statement
373
374    Revision 1.2  2003/11/30 17:32:48  Administrator
375    merged into default
376
377    Revision 1.1.1.1.2.2  2003/11/30 16:57:05  Administrator
378    merged into default
379
380    Revision 1.1.1.1.2.1  2003/11/30 14:45:23  Administrator
381    added CVS id/log
382
383
384=cut
385
386