#!/usr/bin/perl

# wants one or more font names on the command line. If none given, use full
# list of core fonts. If -s given as first arg, use the short list.

# CAUTION: the displayed Unicode value (U=xxxx) appears to be correct in most
# cases, except that the MS Smart Quotes (32 characters) are given as U=0080
# through U=009F. Those Unicode values are reserved for the C1 Control character
# group, not printable glyphs. I don't know if the font files hold incorrect
# Unicode values, or this program is in error. See PDF::Builder::Resource::
# Glyphs for u2n and n2u tables -- they may be in error. What the mapping is 
# from Unicode to the various pages and 00..FF within each page is not clear at 
# this point, although the "Latinx" encodings seem to be mostly OK. Note that 
# most fonts spill over onto 1 or more additional pages, which of course is 
# beyond single byte encoding.

use strict;
use warnings;

use lib '../lib';
use PDF::Builder;
use PDF::Builder::Util;

#my $compress = 'none';  # uncompressed streams
my $compress = 'flate';  # compressed streams

my $sx = 33;
my $sy = 45;
my $fx = 20;
my $gLLx = 50;  # lower left position of grid
my $gLLy = 50;

# default list of core fonts if user doesn't provide command line list
my @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
    georgia
    georgiaitalic
    georgiabold
    georgiabolditalic
    trebuchet
    trebuchetbold
    trebuchetbolditalic
    trebuchetitalic
    verdana
    verdanaitalic
    verdanabold
    verdanabolditalic
    wingdings
    webdings
};
# It's not clear what is being shown for Bank Gothic.
#  1. There is only Regular and Italic -- no bold variants
#  2. It doesn't look like the Bank Gothic shown on sample font pages --
#     perhaps it's some other sans serif font being substituted
#   bankgothic
#   bankgothicbold
#   bankgothicbolditalic
#   bankgothicitalic

my @ARGVcopy = @ARGV;
# 'short' (-s flag)?
if (@ARGVcopy > 0 && $ARGVcopy[0] eq '-s') {
    @ARGVcopy = qw{
        Courier-Bold
	Times-Italic
	Symbol
    };
}

# use only with single byte encodings, as multibyte (including UTF-8) don't
# appear to be compatible with these core fonts
# there may be a number of aliases available for each encoding.
# available encodings (believed to be single byte): 
#   7bit-jis  AdobeStandardEncoding  AdobeSymbol  AdobeZdingbat  ascii  
#   ascii-ctrl  cp1006  cp1026  cp1047  cp1250  cp1251  cp1252  cp1253  cp1254  
#   cp1255  cp1256  cp1257  cp1258  cp37  cp424  cp437  cp500  cp737  cp775  
#   cp850  cp852  cp855  cp856  cp857  cp858  cp860  cp861  cp862  cp863  cp864 
#   cp865  cp866  cp869  cp874  cp875  dingbats  hp-roman8  iso-8859-1  
#   iso-8859-2  iso-8859-3  iso-8859-4  iso-8859-5  iso-8859-6  iso-8859-7  
#   iso-8859-8  iso-8859-9  iso-8859-10  iso-8859-11  iso-8859-13  iso-8859-14  
#   iso-8859-15  iso-8859-16  iso-ir-165  jis0201-raw  koi8-f  koi8-r  koi8-u  
#   MacArabic  MacCentralEurRoman  MacCroatian  MacCyrillic  MacDingbats  
#   MacFarsi  MacGreek  MacHebrew  MacIcelandic  MacRoman  MacRomanian  
#   MacRumanian  MacSami  MacSymbol  MacThai  MacTurkish  MacUkrainian  nextstep
#   null  posix-bc  symbol  viscii
# multibyte encodings (do not use):
#  big5-eten  big5-hkscs  cp932  cp936  cp949  cp950  euc-cn  euc-jp  euc-kr  
#  gb12345-raw  gb2312-raw  gsm0338  hz  iso-2022-jp  iso-2022-jp-1  iso-2022-kr
#  jis0208-raw  jis0212-raw  johab  ksc5601-raw  MacChineseSimp  MacChineseTrad 
#  MacJapanese  MacKorean  MIME-B  MIME-Header  MIME-Header-ISO_2022_JP  MIME-Q 
#  shiftjis  UCS-2BE  UCS-2LE  UTF-16  UTF-16BE  UTF-16LE  UTF-32  UTF-32BE  
#  UTF-32LE  UTF-7  utf-8-strict  utf8   and probably others
my @ecs = qw{
    latin1 
    latin2 
    latin3 
    latin4 
    latin5 
    latin6 
    latin7 
    latin8 
    latin9 
    latin10
};
# just Latin-1 for now...
@ecs = qw{ latin1 };

my ($y, $pdf, $f1);

# override default list with command line entries
if (scalar @ARGVcopy && $ARGVcopy[0] ne '-s') {
    @fns = @ARGVcopy;
}

# loop through list of font names
foreach my $fn (@fns) {
    # at least one page for each encoding 
    foreach my $ec (@ecs) {
        $pdf = PDF::Builder->new(-compress => $compress);
        $f1 = $pdf->corefont('Helvetica');  # for various labels

        print STDERR "\n$fn -- $ec\n";
        initNameTable();  # set up u2n and n2u hashes
        my $fnt = $pdf->corefont($fn, -encode => $ec);
        my @planes = ($fnt, $fnt->automap());
	my $flight = -1;
        foreach my $plane (@planes) {   
	    $flight++;
            # subfonts within overall font (223 characters per plane + space)
	    # they can be treated just like regular fonts
            my $page = $pdf->page();
            $page->mediabox(595,842);

            my $gfx = $page->gfx();

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

            my $txt2 = $page->text();

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

            $txt2->font($f1, 5);
            $txt2->hscale(80);

	    # distance below baseline (<0) to clear descenders
            my $u = $plane->underlineposition()*$fx/1000;

	    # draw grid of characters and information
	    # yp character row value (0..F T to B)
            foreach my $yp (0..15) {
		$y = 15 - $yp;  # y vertical (row) position T to B
                print STDERR ".";
                foreach my $x (0..15) {  # x horizontal (column) position L to R
                    $txt->translate($gLLx+($sx*$x),$gLLy+($sy*$y));
		    my $ci = $yp*16 + $x;  # 0..255 value
		    my $c  = chr($ci);
                    $txt->text($c);

                    my $wx = $plane->width($c)*$fx;

		    # bounding box cell around character
                    $gfx->strokecolor('lightblue');
		    if ($plane->wxMissingByEnc($ci)) { $gfx->fillcolor(1.0, 0.7, 0.7); }
                    $gfx->move($gLLx+($sx*$x)    ,$gLLy+($sy*$y)+$fx);
                    $gfx->line($gLLx+($sx*$x)    ,$gLLy+($sy*$y)+$u);
                    $gfx->line($gLLx+($sx*$x)+$wx,$gLLy+($sy*$y)+$u);
                    $gfx->line($gLLx+($sx*$x)+$wx,$gLLy+($sy*$y)+$fx);
                    $gfx->close();
		    if ($plane->wxMissingByEnc($ci)) {
                        $gfx->fillstroke();
                        $gfx->fillcolor('black');
		    } else {
			$gfx->stroke();
		    }

		    # baseline
                    $gfx->strokecolor('gray');
                    $gfx->move($gLLx+($sx*$x)    ,$gLLy+($sy*$y));
                    $gfx->line($gLLx+($sx*$x)+$wx,$gLLy+($sy*$y));
                    $gfx->stroke();

		    # character data
                    $txt2->translate($gLLx+($sx*$x)+$wx,$gLLy+($sy*$y)-6);
                    $txt2->text_right($ci);
                    $txt2->translate($gLLx+($sx*$x)+$wx,$gLLy+($sy*$y)-11);
                    if (defined $plane->uniByEnc($ci)) {
                        $txt2->text_right(sprintf('U+%04X',$plane->uniByEnc($ci)));
                    } else {
                        $txt2->text_right('U+????');
		    }
                    $txt2->translate($gLLx+($sx*$x)+$wx,$gLLy+($sy*$y)-16);
                    $txt2->text_right($plane->glyphByEnc($ci));
                    $txt2->translate($gLLx+($sx*$x)+$wx,$gLLy+($sy*$y)-21);
                    $txt2->text_right(sprintf('wx=%i',$plane->wxByEnc($ci)));
                } # loop through columns (x)
            } # loop through rows (yp/y)
            print STDERR "\n";
        } # loop through "sub" fonts (planes)
        $pdf->saveas("$0.$fn.$ec.pdf");
        $pdf->end();

    } # loop through each encoding (ec)
} # loop for each font name (fn)

exit;

__END__