#!/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: 023_cjkfonts,v 1.1 2004/04/06 23:08:57 fredo Exp $
#
#=======================================================================

use PDF::API2;
use PDF::API2::Util;
use Unicode::UCD 'charinfo';

my $sx=33;
my $sy=45;
my $fx=20;
#japanese2 korean simplified traditional
foreach $fn (qw( korean )) {

    $pdf=PDF::API2->new(-file => "$0.$fn.pdf");

    $f1=$pdf->corefont('Helvetica');

    print STDERR "\n$fn\n";

    my $font=$pdf->cjkfont($fn);
    $font->tounicodemap;
    my @cids=(0 .. $font->glyphNum-1);
    my @fbbx = $font->fontbbox;
    my $xw = int(($fbbx[2]-$fbbx[0])/20)*20;
    my $yw = int(($fbbx[3]-$fbbx[1])/20)*20;
    my $fw = $xw>$yw ? $yw : $xw;
    my $mw=800/$fw;
    my $y0=int((20-$fbbx[1])/20)*20*$mw;

    while(scalar @cids>0) {

        $page = $pdf->page;
        $page->mediabox(595,842);

        $gfx=$page->gfx;

        foreach my $y (750,700,650,600,550,500,450,400,350,300,250,200,150,100,50) {
            foreach my $x (50,100,150,200,250,300,350,400,450,500) {
                my $xo=shift @cids;
                $gfx->save;
                $gfx->transform(-translate => [$x, $y], -scale => [0.045, 0.045]);

                $gfx->linewidth(10);
                $gfx->rect(0,0,1000,1000);
                $gfx->stroke;

                my $wx=$font->wxByCId($xo)*$mw;
                my $x0=(1000-$wx)/2;

                $gfx->linedash(10,20);
                $gfx->linewidth(0.5);
                $gfx->move($x0,0);
                $gfx->line($x0,1000);
                $gfx->move($x0+$wx,1000);
                $gfx->line($x0+$wx,0);
                $gfx->move(0,$y0);
                $gfx->line(1000,$y0);
                $gfx->stroke;

                $gfx->textstart;
                $gfx->font($font,1000*$mw);
                $gfx->translate($x0,$y0);
                $gfx->add($font->text_cid(pack('n',$xo)),'Tj');

                $gfx->font($f1,80);
                $gfx->hspace(80);
                $gfx->translate(25,810);
                $gfx->text("G+$xo"); 
                $gfx->translate(25,10);
                $gfx->text(sprintf('U+0x%04X',$font->uniByCId($xo)));
                $gfx->translate(975,10);
                $gfx->text_right('wx='.$font->wxByCId($xo));


                my $ci = charinfo($font->uniByCId($xo) || 0);
                my $name=$font->glyphByCId($xo);

                if($name=~m|^uni[0-9a-f]{4}$|io) {
                    $gfx->fillcolor('red');
                    $name=$ci->{name} || "NONE";
                } else {
                    $gfx->fillcolor('blue');
                }
                $gfx->translate(975,910);
                $gfx->hspace(70);
                $gfx->text_right($name);

                $gfx->textend;
                $gfx->restore;

                last unless(scalar @cids>0);
            }
            last unless(scalar @cids>0);
        }
        print STDERR ".";
        $pdf->finishobjects($page,$gfx);
    }
    $pdf->save;
    $pdf->end;
    last;
}

exit;

__END__

=head1 HISTORY

    $Log: 023_cjkfonts,v $
    Revision 1.1  2004/04/06 23:08:57  fredo
    genesis


=cut