#!/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: 027_winfont,v 2.1 2006/06/15 21:12:22 areibens Exp $
#
#=======================================================================
use File::Basename;
use PDF::API3::Compat::API2;
use PDF::API3::Compat::API2::Util;
use PDF::API3::Compat::API2::Win32;
use Unicode::UCD 'charinfo';
use Encode qw[:all];
use Getopt::Long;
use Data::Dumper;
use utf8;
%wxf=PDF::API3::Compat::API2->enumwinfonts;
foreach my $k (sort keys %wxf)
{
        print "font '$wxf{$k}' has key '$k'\n";
    $api=PDF::API3::Compat::API2->new();
     
    $api->mediabox(595,842);
     
    $helv=$api->corefont('Helvetica-Bold',-encode=>'latin1');
     
    my $sx=33;
    my $sy=45;
    my $fx=20;
    my $xf=$api->winfont($k,-encode=>'latin1');
    my $page = $api->page;
    $page->mediabox(595,842);
    my $gfx=$page->gfx;
#    $gfx->textlabel(50,800,$helv,20,$wxf{$k},-hspace=>90);
    $gfx->textlabel(50,800,$helv,20,$wxf{$k});
     
    foreach $x (0..15) 
    {
        foreach $y (0..15) 
        {
            $gfx->textlabel(50+($sx*$x),50+($sy*$y),$xf,$fx,pack('C',$y*16+$x));
            $gfx->textlabel(50+($sx*$x),50+($sy*$y)-6,$helv,6,nameByUni($y*16+$x),-color=>'#a00000',-hspace=>80,-rotate=>-15);
        }
    }
    if(UNIVERSAL::can($xf,'uniByCId') && UNIVERSAL::can($xf,'glyphNum')) 
    {
        my @cids=(0 .. $xf->glyphNum-1);
        my @fbbx = $xf->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 = $api->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->fillcolor('black');
                    $gfx->transform(-translate => [$x, $y], -scale => [0.045, 0.045]);
     
                    $gfx->linewidth(10);
                    $gfx->rect(0,0,1000,1000);
                    $gfx->stroke;
     
                    my $wx=$xf->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($xf,1000*$mw);
                    $gfx->translate($x0,$y0);
                    $gfx->add($xf->text_cid(pack('n',$xo)),'Tj');
     
                    $gfx->font($helv,100);
                    $gfx->hspace(80);
                    $gfx->translate(25,860);
                    $gfx->text("G+$xo"); 
                    $gfx->translate(25,10);
                    $gfx->text(sprintf('U+0x%04X',$xf->uniByCId($xo)));
     
                    my $name=$xf->glyphByCId($xo);
                    if($name eq '') {
                        $gfx->fillcolor('red');
                        $name="NONE";
                    } else {
                        $gfx->fillcolor('blue');
                    }
     
                    $gfx->hspace(70);
                    $gfx->translate(975,860);
                    $gfx->text_right($name);
     
                    $gfx->fillcolor('black');
                    $gfx->translate(975,10);
                    $gfx->text_right('wx='.$xf->wxByCId($xo));
     
                    $gfx->fillcolor('#008000');
                    $gfx->translate(500,950);
                    $gfx->hspace(70);
                    my $ci = charinfo($xf->uniByCId($xo) || 0);
                    $gfx->font($helv,50);
                    $gfx->text_center($ci->{name});
     
                    $gfx->textend;
                    $gfx->restore;
     
                    last unless(scalar @cids>0);
                }
                last unless(scalar @cids>0);
            }
            print STDERR ".";
            ## $api->finishobjects($page,$gfx);
        }
    }
    $api->saveas("$0.$k.pdf");
    $api->end;
}
#print Dumper($PDF::API3::Compat::API2::wf);
__END__