The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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: 020_corefonts,v 2.1 2007/08/07 20:40:45 areibens Exp $
#
#=======================================================================
use lib '../lib';
use PDF::API2;
use PDF::API2::Util;

my $sx=33;
my $sy=45;
my $fx=20;
@fns=qw{
    Helvetica
    Helvetica-Oblique
    Helvetica-Bold
    Helvetica-BoldOblique
    Courier
    Courier-Oblique
    Courier-Bold
    Courier-BoldOblique
    Times-Roman
    Times-Italic
    Times-Bold
    Times-BoldItalic
    Symbol
    ZapfDingbats
    bankgothic
    georgia
    georgiaitalic
    georgiabold
    georgiabolditalic
    trebuchet
    trebuchetbold
    trebuchetbolditalic
    trebuchetitalic
    verdana
    verdanaitalic
    verdanabold
    verdanabolditalic
    wingdings
    webdings
};

@ecs=qw{
    latin1 
    latin2 
    latin3 
    latin4 
    latin5 
    latin6 
    latin7 
    latin8 
    latin9 
    latin10
};

if(scalar @ARGV)
{
    @fns=@ARGV;
}

foreach $fn (@fns) 
{
    foreach $ec (qw{ latin1 }) 
    {

        $pdf=PDF::API2->new;

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

        print STDERR "\n$fn -- $ec\n";
        initNameTable();
        my $fnt=$pdf->corefont($fn,-encode => $ec);
        my @fonts=($fnt,$fnt->automap());
        foreach my $font (@fonts) 
        {

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

            my $gfx=$page->gfx;

            my $txt=$page->text;
                $txt->font($font,$fx);

            my $txt2=$page->text;

            $txt2->textlabel(50,800,$f1,20,"font='".$font->fontname." / ".$font->name."'",-hspace=>75);
            $txt2->textlabel(50,780,$f1,20,"encoding='$ec'");

            $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)));
                }
            }
            print STDERR "\n";
        }
        $pdf->saveas("$0.$fn.$ec.pdf");
        $pdf->end();

    }
}

exit;

__END__