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