1#!/usr/bin/perl -w 2#======================================================================= 3# ____ ____ _____ _ ____ ___ ____ 4# | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \ 5# | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) | 6# | __/| |_| | _| _ _ / ___ \| __/| | / __/ 7# |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____| 8# 9# A Perl Module Chain to faciliate the Creation and Modification 10# of High-Quality "Portable Document Format (PDF)" Files. 11# 12# Copyright 1999-2004 Alfred Reibenschuh <areibens@cpan.org>. 13# 14#======================================================================= 15# 16# PERMISSION TO USE, COPY, MODIFY, AND DISTRIBUTE THIS FILE FOR 17# ANY PURPOSE WITH OR WITHOUT FEE IS HEREBY GRANTED, PROVIDED THAT 18# THE ABOVE COPYRIGHT NOTICE AND THIS PERMISSION NOTICE APPEAR IN ALL 19# COPIES. 20# 21# THIS FILE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED 22# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 23# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 24# IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR 25# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF 28# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 29# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 30# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 31# OF THE USE OF THIS FILE, EVEN IF ADVISED OF THE POSSIBILITY OF 32# SUCH DAMAGE. 33# 34# $Id: 023_cjkfonts,v 2.1 2007/04/07 10:28:35 areibens Exp $ 35# 36#======================================================================= 37use lib qw{ ../lib }; 38use PDF::API3::Compat::API2; 39use PDF::API3::Compat::API2::Util; 40use Unicode::UCD 'charinfo'; 41my $LoremIpsum=q|Sed ut perspiciatis, unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam eaque ipsa, quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt, explicabo. Nemo enim ipsam voluptatem, quia voluptas sit, aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos, qui ratione voluptatem sequi nesciunt, neque porro quisquam est, qui dolorem ipsum, quia dolor sit, amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt, ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit, qui in ea voluptate velit esse, quam nihil molestiae consequatur, vel illum, qui dolorem eum fugiat, quo voluptas nulla pariatur? At vero eos et accusamus et iusto odio dignissimos ducimus, qui blanditiis praesentium voluptatum deleniti atque corrupti, quos dolores et quas molestias excepturi sint, obcaecati cupiditate non provident, similique sunt in culpa, qui officia deserunt mollitia animi, id est laborum et dolorum fuga. Et harum quidem rerum facilis est et expedita distinctio. Nam libero tempore, cum soluta nobis est eligendi optio, cumque nihil impedit, quo minus id, quod maxime placeat, facere possimus, omnis voluptas assumenda est, omnis dolor repellendus. Temporibus autem quibusdam et aut officiis debitis aut rerum necessitatibus saepe eveniet, ut et voluptates repudiandae sint et molestiae non recusandae. Itaque earum rerum hic tenetur a sapiente delectus, ut aut reiciendis voluptatibus maiores alias consequatur aut perferendis doloribus asperiores repellat.|; 42my $sx=33; 43my $sy=45; 44my $fx=20; 45# 46# Ming Ming-Bold Ming-Italic Ming-BoldItalic 47# Song Song-Bold Song-Italic Song-BoldItalic 48# MyungJo MyungJo-Bold MyungJo-Italic MyungJo-BoldItalic 49# KozMin KozMin-Bold KozMin-Italic KozMin-BoldItalic 50# KozGo KozGo-Bold KozGo-Italic KozGo-BoldItalic 51# 52foreach $fn (qw[ 53 Ming Ming-Bold Ming-Italic Ming-BoldItalic 54 Song Song-Bold Song-Italic Song-BoldItalic 55 MyungJo MyungJo-Bold MyungJo-Italic MyungJo-BoldItalic 56 KozMin KozMin-Bold KozMin-Italic KozMin-BoldItalic 57 KozGo KozGo-Bold KozGo-Italic KozGo-BoldItalic 58]) { 59 60 $pdf=PDF::API3::Compat::API2->new(-file => "$0.$fn.pdf"); 61 62 $f1=$pdf->corefont('Helvetica'); 63 64 print STDERR "\n$fn\n"; 65 66 my $font=$pdf->cjkfont($fn); 67 $font->tounicodemap; 68 my @cids=(0 .. $font->glyphNum-1); 69 my @fbbx = $font->fontbbox; 70 my $xw = int(($fbbx[2]-$fbbx[0])/20)*20; 71 my $yw = int(($fbbx[3]-$fbbx[1])/20)*20; 72 my $fw = $xw>$yw ? $yw : $xw; 73 my $mw=800/$fw; 74 my $y0=int((20-$fbbx[1])/20)*20*$mw; 75 76 while(scalar @cids>0) { 77 78 $page = $pdf->page; 79 $page->mediabox(595,842); 80 81 $gfx=$page->gfx; 82 83 foreach my $y (750,700,650,600,550,500,450,400,350,300,250,200,150,100,50) { 84 foreach my $x (50,100,150,200,250,300,350,400,450,500) { 85 my $xo=shift @cids; 86 $gfx->save; 87 $gfx->transform(-translate => [$x, $y], -scale => [0.045, 0.045]); 88 89 $gfx->linewidth(10); 90 $gfx->rect(0,0,1000,1000); 91 $gfx->stroke; 92 93 my $wx=$font->wxByCId($xo)*$mw; 94 my $x0=(1000-$wx)/2; 95 96 $gfx->linedash(10,20); 97 $gfx->linewidth(0.5); 98 $gfx->move($x0,0); 99 $gfx->line($x0,1000); 100 $gfx->move($x0+$wx,1000); 101 $gfx->line($x0+$wx,0); 102 $gfx->move(0,$y0); 103 $gfx->line(1000,$y0); 104 $gfx->stroke; 105 106 $gfx->textstart; 107 $gfx->font($font,1000*$mw); 108 $gfx->translate($x0,$y0); 109 $gfx->add($font->text_cid(pack('n',$xo)),'Tj'); 110 111 $gfx->font($f1,80); 112 $gfx->hspace(80); 113 $gfx->translate(25,810); 114 $gfx->text("G+$xo"); 115 $gfx->translate(25,10); 116 $gfx->text(sprintf('U+0x%04X',$font->uniByCId($xo))); 117 $gfx->translate(975,10); 118 $gfx->text_right('wx='.$font->wxByCId($xo)); 119 120 121 my $ci = charinfo($font->uniByCId($xo) || 0); 122 my $name=$font->glyphByCId($xo); 123 124 if($name=~m|^uni[0-9a-f]{4}$|io) { 125 $gfx->fillcolor('red'); 126 $name=$ci->{name} || "NONE"; 127 } else { 128 $gfx->fillcolor('blue'); 129 } 130 $gfx->translate(975,910); 131 $gfx->hspace(70); 132 $gfx->text_right($name); 133 134 $gfx->textend; 135 $gfx->restore; 136 137 last unless(scalar @cids>0); 138 } 139 last unless(scalar @cids>0); 140 } 141 print STDERR "."; 142 $pdf->finishobjects($page,$gfx); 143 } 144 145 my $text=$LoremIpsum; 146 147 $page = $pdf->page; 148 $page->mediabox(595,842); 149 $gfx=$page->gfx; 150 $gfx->transform(-translate => [50, 800]); 151 $gfx->textstart; 152 $gfx->fillcolor('black'); 153 $gfx->font($font,18); 154 $gfx->lead(18*1.25); 155 my $toprint; 156 while($text ne '') 157 { 158 ($toprint,$text)=$gfx->_text_fill_line($text,500,0); 159 $gfx->text($toprint); 160 $gfx->nl; 161 } 162 $gfx->textend; 163 164 $pdf->save; 165 $pdf->end; 166} 167 168exit; 169 170__END__ 171 172=head1 HISTORY 173 174 $Log: 023_cjkfonts,v $ 175 Revision 2.1 2007/04/07 10:28:35 areibens 176 added lorem ipsum page 177 178 Revision 2.0 2005/11/16 02:16:00 areibens 179 revision workaround for SF cvs import not to screw up CPAN 180 181 Revision 1.2 2005/11/16 01:27:48 areibens 182 genesis2 183 184 Revision 1.1 2005/11/16 01:19:24 areibens 185 genesis 186 187 Revision 1.3 2005/09/12 16:55:05 fredo 188 various updates 189 190 Revision 1.2 2004/12/31 02:59:35 fredo 191 no message 192 193 Revision 1.1 2004/04/06 23:08:57 fredo 194 genesis 195 196 197=cut