#!/usr/bin/perl #======================================================================= # ____ ____ _____ _ ____ ___ ____ # | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \ # | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) | # | __/| |_| | _| _ _ / ___ \| __/| | / __/ # |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____| # # A Perl Module Chain to faciliate the Creation and Modification # of High-Quality "Portable Document Format (PDF)" Files. # # Copyright 1999-2004 Alfred Reibenschuh <areibens@cpan.org>. # #======================================================================= # # PERMISSION TO USE, COPY, MODIFY, AND DISTRIBUTE THIS FILE FOR # ANY PURPOSE WITH OR WITHOUT FEE IS HEREBY GRANTED, PROVIDED THAT # THE ABOVE COPYRIGHT NOTICE AND THIS PERMISSION NOTICE APPEAR IN ALL # COPIES. # # THIS FILE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED # WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. # IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF # USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT # OF THE USE OF THIS FILE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: 022_truefonts_diacrits_utf8,v 1.1 2007/10/23 07:48:08 areibens Exp $ # #======================================================================= use lib qw{ ../lib }; use File::Basename; use PDF::API2; use PDF::API2::Util; use Unicode::UCD 'charinfo'; use Getopt::Long; use utf8; my $sx=33; my $sy=45; my $fx=20; my $LoremIpsum=qq|Sed ut perspici\x{0361}atis.|; my $encoding='latin1'; GetOptions( "encode|e=s" => \$encoding, ); foreach $fn (@ARGV) { $pdf=PDF::API2->new(-file => basename($0).'.'.basename($fn).".pdf"); $f1=$pdf->corefont('Helvetica', -encode => 'latin1'); $f2=$pdf->corefont('Helvetica-Bold', -encode => 'latin1'); print STDERR "\n$fn\n"; my $font=$pdf->ttfont($fn, -encode => $encoding); $font->data->{nosubset}=1; if(1) { my $page = $pdf->page; $page->mediabox(595,842); my $gfx=$page->gfx; my $txt=$page->text; $txt->font($font,$fx); my $txt2=$page->text; #delete $txt->{Filter}; #delete $txt2->{Filter}; $txt2->textlabel(50,800,$f1,20,"font='".$font->fontname."'"); $txt2->textlabel(50,780,$f1,20,"encoding='$encoding'"); $txt2->font($f1,5); $txt2->hspace(80); my $u=$font->underlineposition*$fx/1000; foreach $x (0..15) { print STDERR "."; foreach $y (0..15) { $txt->translate(50+($sx*$x),50+($sy*$y)); $txt->text(chr($y*16+$x)); my $wx=$font->width(chr($y*16+$x))*$fx; $gfx->strokecolor('lightblue'); $gfx->move(50+($sx*$x),50+($sy*$y)+$fx); $gfx->line(50+($sx*$x),50+($sy*$y)+$u); $gfx->line(50+($sx*$x)+$wx,50+($sy*$y)+$u); $gfx->line(50+($sx*$x)+$wx,50+($sy*$y)+$fx); $gfx->close; $gfx->stroke; $gfx->strokecolor('gray'); $gfx->move(50+($sx*$x),50+($sy*$y)); $gfx->line(50+($sx*$x)+$wx,50+($sy*$y)); $gfx->stroke; $txt2->translate(50+($sx*$x)-2,50+($sy*$y)-6); $txt2->text_right($y*16+$x); $txt2->translate(50+($sx*$x)-2,50+($sy*$y)-11); $txt2->text_right(sprintf('U=0x%04X',$font->uniByEnc($y*16+$x))); $txt2->translate(50+($sx*$x)-2,50+($sy*$y)-16); $txt2->text_right($font->glyphByEnc($y*16+$x)); $txt2->translate(50+($sx*$x)-2,50+($sy*$y)-21); $txt2->text_right(sprintf('wx=%i',$font->wxByEnc($y*16+$x))); } } } my $text=$LoremIpsum; $page = $pdf->page; $page->mediabox(595,842); $gfx=$page->gfx; $gfx->transform(-translate => [50, 800]); $gfx->textstart; $gfx->fillcolor('black'); $gfx->font($font,18); $gfx->lead(18*1.25); my $toprint; while($text ne '') { ($toprint,$text)=$gfx->_text_fill_line($text,500,0); $gfx->text($toprint); $gfx->nl; } $gfx->textend; $pdf->save; $pdf->end; } exit; __END__ =head1 HISTORY $Log: 022_truefonts_diacrits_utf8,v $ Revision 1.1 2007/10/23 07:48:08 areibens genesis Revision 2.2 2007/04/07 10:26:23 areibens added lorem ipsum page Revision 2.1 2006/06/19 19:20:13 areibens added details Revision 2.0 2005/11/16 02:16:00 areibens revision workaround for SF cvs import not to screw up CPAN Revision 1.2 2005/11/16 01:27:48 areibens genesis2 Revision 1.1 2005/11/16 01:19:24 areibens genesis Revision 1.3 2005/09/12 16:55:05 fredo various updates Revision 1.2 2004/12/31 02:58:49 fredo no message Revision 1.1 2004/04/06 23:04:06 fredo genesis =cut