#!/usr/bin/perl

use strict;
use warnings;

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

my $type = 0;  # 0 = full list of core fonts
               # 1 = single core font (for testing)
	       # 2 = TTF font(s)
	       # 3 = Type1 (PS) font(s)
my $encoding = 'latin1';  # normally latin1

my @variants = ();
my @varLabels = ();
# show slant example
push @variants, {-slant=>0.750};
push @varLabels, 'slant 0.750';
# show oblique example
push @variants, {-oblique=>12};
push @varLabels, 'oblique 12';
# show bold example
push @variants, {-bold=>4};
push @varLabels, 'bold 4';
# show small caps example
push @variants, {-caps=>1};
push @varLabels, 'caps 1';

my $compress = 'none'; # no stream compression
#my $compress = 'flate'; # compress streams

my $sx = 33;
my $sy = 45;
my $fx = 20;

my ($ci, $y, $k);

my (@font_list, @short_name, @T1_metrics);
# core
if ($type == 0) {
  @font_list = qw(
    Times-Roman
    Times-Italic
    Times-Bold
    Times-BoldItalic
    Courier
    Courier-Oblique
    Courier-Bold
    Courier-BoldOblique
    Helvetica
    Helvetica-Oblique
    Helvetica-Bold
    Helvetica-BoldOblique
    Symbol
    ZapfDingbats
    bankgothic
    georgia
    georgiaitalic
    georgiabold
    georgiabolditalic
    trebuchet
    trebuchetitalic
    trebuchetbold
    trebuchetbolditalic
    verdana
    verdanaitalic
    verdanabold
    verdanabolditalic
    wingdings
    webdings);
}
if ($type == 1) {
  @font_list = qw( Times-Roman ); 
}
  
# note that for TTF and Type1, spaces in names (Windows) replaced by ~
# TTF
if ($type == 2) {
  @font_list = qw( C:\\Windows\\Fonts\\calibri.ttf ); 
  @short_name = qw( Calibri );
}

# Type1
if ($type == 3) {
# note that URWPalladioL appears to have some internal problems, resulting
# in some characters appearing in the wrong slot. other fonts are OK, and there
# is no obvious pattern, so for now it can't be fixed. suspect a bad font
# "encoding map" resulting is mismapping by BaseFont::strByUtf to wrong 
# character in BaseFont::textByStr returned to BaseFont::text
   #C:\\T1fonts\\URWPalladioL-Roma.pfb
  @font_list = qw( 
    C:\\T1fonts\\gfsneohellenic\\type1\\GFSNeohellenic-Regular.pfb
    C:\\Program~Files~(x86)\\MiKTeX~2.9\\fonts\\type1\\urw\\avantgar\\uagd8a.pfb
		 );
   #C:\\T1fonts\\URWPalladioL-Roma.afm
  @T1_metrics = qw(
    C:\\T1fonts\\gfsneohellenic\\afm\\GFSNeohellenic-Regular.afm
    C:\\Program~Files~(x86)\\MiKTeX~2.9\\fonts\\type1\\urw\\avantgar\\uagd8a.pfm
		  );
   #Palladio 
  @short_name = qw(
    Neohellenic 
    Avant~Garde
                  );
}

my ($metrics, $sname);
# outer loop, one file each for Times-Roman, Times-Italic, etc.
foreach my $fn (@font_list) {
    $fn =~ s/~/ /g; # restore name
    if ($type == 3) {
      # Type1 also has metrics file
      $metrics = shift @T1_metrics;
      $metrics =~ s/~/ /g; # restore name
    }
    if ($type < 2) {
      # core fn and sname are the same
      $sname = $fn;
    } else {
      # TTF and Type1 have font short name
      $sname = shift @short_name;
      $sname =~ s/~/ /g; # restore name
    }

    my $pdf = PDF::Builder->new(-compress => $compress);
    initNameTable();

    my $f1 = $pdf->corefont('Helvetica');  # for various labels

    print STDERR "\n$fn\n";


    my $fn1;
    if ($type == 0 || $type == 1) {
      $fn1 = $pdf->corefont($fn, -encode => $encoding);
    } elsif ($type == 2) {
      $fn1 = $pdf->ttfont($fn, -encode => $encoding);
    } else { # type == 3
      if ($metrics =~ m/\.afm/i) {
        $fn1 = $pdf->psfont($fn, -afmfile => $metrics, -encode => $encoding);
      } else {
        $fn1 = $pdf->psfont($fn, -pfmfile => $metrics, -encode => $encoding);
      }
    }

    my @planes;
    if ($type != 2) {
      @planes = ($fn1, $fn1->automap());
    } else {
      # TrueType can't use automap. Need to get to glyphs beyond basic encoding
      @planes = ($fn1);   
    }

    print STDERR "  ".(scalar @variants)." variants of font, each up to ".
                      (scalar @planes)." page(s)\n";

    foreach my $varNum ( 0 .. $#variants ) {
	# 4 or so variants requested per font
	$k = $variants[$varNum];

        foreach my $fnt (@planes) {  
	    # individual planes of each font, character list varies by font

            my $font = $pdf->synfont($fnt, %{$k});

	    # check if there is anything to be shown in this plane ($fnt)
	    my $flag = 0; # no character found yet
	    foreach my $yp (0..15) {
		foreach my $x (0..15) {
		    $ci = $yp*16 + $x;  # 0..255 value
		    # always seems to be something at
		    # ci = 32 (U+0020, space)
		    # ci = 33 (U+E000, .notdef)
		    if ($ci == 32 || $ci == 33) { next; }

		    if (defined $fnt->uniByEnc($ci) && $fnt->uniByEnc($ci) > 0) {
			$flag = 1;  # found at least one character (glyph)
			last;
		    }
		}
		if ($flag) { last; }
            }
	    if (!$flag) { next; } # no glyphs to show on this plane

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

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

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

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

                $txt2->translate(50,800);
                $txt2->font($f1, 20);
		if (defined $font->fontname()) {
		    $xname = $font->fontname();
		} else {
		    $xname = $sname;
		}
		if (defined $font->name()) {
		    $y = $font->name();
		} else {
		    $y = '??????';
		}
                $txt2->text("font='$xname / $y'");

                $txt2->translate(50,780);
		$txt2->font($f1, 15);
		$txt2->text("variant = $varLabels[$varNum]");
                $txt2->translate(300,780);
		$txt2->text("encoding = $encoding");

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

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

            print STDERR ".";  # one . per page
	    # draw grid of characters and information
	    # yp character row value (increasing)
            foreach my $yp (0 .. 15) {
		$y = 15 - $yp;  # y vertical (row) position T to B
                foreach my $x (0 .. 15) {
                    $txt->translate(50+($sx*$x), 50+($sy*$y));
		    $ci = $yp*16 + $x;
		    my $c  = chr($ci);
                    $txt->text($c);

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

		    # bound box cell around character
                    $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();

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

		    # character data
                    $txt2->translate(50+($sx*$x)+$wx, 50+($sy*$y)-6);
                    $txt2->text_right($ci);
                    $txt2->translate(50+($sx*$x)+$wx, 50+($sy*$y)-11);
                    if (defined $font->uniByEnc($ci)) {
                        $txt2->text_right(sprintf('U+%04X',$font->uniByEnc($ci)));
		    } else {
                        $txt2->text_right('U+????');
	            }
                    $txt2->translate(50+($sx*$x)+$wx, 50+($sy*$y)-16);
                    $txt2->text_right($font->glyphByEnc($ci));
                    $txt2->translate(50+($sx*$x)+$wx, 50+($sy*$y)-21);
                    $txt2->text_right(sprintf('wx=%i', $font->wxByEnc($ci)));
                }
            }

        } # end inner loop of 1 or more font pages
    } # end middle loop of @variants list
    
    $pdf->saveas("$0.$sname.pdf");
    $pdf->end();
    print STDERR "\n";
   #last;
} # loop of typefaces  Times-Roman, Times-Italic, etc. separate files
exit;

__END__
