#!/usr/bin/perl

# command line defaults to 0 (full list of core fonts). 1 or -s is for a
# short list, 2 is a single TTF, and 3 is a single Type 1

use strict;
use warnings;

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

my $type = 0;  # 0 = full list of core fonts 
               # 1 or -s = single core font (for testing)
	       # 2 = TTF font(s)
	       # 3 = Type1 (PS) font(s)
my $encoding = 'latin1';  # normally latin1
# TBD future: -t type -e encoding and possibly font name(s) and which variant(s)

# for testing, command line number is type
if (scalar @ARGV > 0) {
    if      ($ARGV[0] eq '-s') {
	$type = 1;  # -s is alias for 1
    } elsif ($ARGV[0] > -1 && $ARGV[0] < 4) {
	# command line type 0 1 2 or 3
	$type = $ARGV[0];
    }
}

my @variants = ();
my @varLabels = ();
# show condense example
push @variants, {-condense=>0.750};
push @varLabels, 'condense 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( Courier-Oblique ); 
}
  
# 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:\\Users\\Phil\\fonts\\T1fonts\\URWPalladioL-Roma.pfb
  @font_list = qw( 
    C:\\Users\\Phil\\fonts\\T1fonts\\gfsneohellenic\\type1\\GFSNeohellenic-Regular.pfb
    C:\\Users\\Phil\\fonts\\T1fonts\\URWPalladioL-Roma.pfb
		 );
   #C:\\Program~Files~(x86)\\MiKTeX~2.9\\fonts\\type1\\urw\\avantgar\\uagd8a.pfb
  @T1_metrics = qw(
    C:\\Users\\Phil\\fonts\\T1fonts\\gfsneohellenic\\afm\\GFSNeohellenic-Regular.afm
    C:\\Users\\Phil\\fonts\\T1fonts\\URWPalladioL-Roma.afm
		  );
   #C:\\Program~Files~(x86)\\MiKTeX~2.9\\fonts\\type1\\urw\\avantgar\\uagd8a.pfm
  @short_name = qw(
    Neohellenic 
    Palladio 
                  );
   #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";
    # Note that synfont() itself only returns a "standard" 255 character font.
    # For characters beyond that (Unicode), you need to get plane 1, 2, etc.
    # and run synfont() against that "font". 'fi' and 'fl' ligatures are 
    # found on plane 1 or 2 (not plane 0 basic). It does not appear possible
    # to replace a ligature on plane 1+ with plane 0 ASCII letters.

    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
    
    # print some text with a weird combination of options.
    # only basic plane (0) $fn1 to be used.

    my $font = $pdf->synfont($fn1, -caps=>1, -bold=>8, -oblique=>-15,
                                   -condense=>3.5, -space=>300);
    my $page = $pdf->page();
    $page->mediabox(595,842);

    my $txt = $page->text();
    $txt->font($font, $fx);
    my $LoremIpsum=q|Sed ut perspiciatis, unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam eaque ipsa, quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt, explicabo. Nemo enim ipsam voluptatem, quia voluptas sit, aspernatur aut odit aut fugit.|;
    # 150% width + 300 milliems, so not much to fill up a page!

    $txt->transform(-translate => [50, 800]);
    $txt->fillcolor('black');
    $txt->font($f1, 18);  # Hevetica labels
    $txt->leading(18*1.25);
    my $title = "caps 1, bold 8, oblique -15, condense 1.5, space 300.";
    my $toprint;
    print STDERR ".";
    while ($title ne '') {
        ($toprint, $title) = $txt->_text_fill_line($title, 500, 0);
    	$txt->text($toprint);
    	$txt->nl();
    }
    $txt->nl();
    $txt->font($font, 18);
    while ($LoremIpsum ne '') {
    	($toprint, $LoremIpsum) = $txt->_text_fill_line($LoremIpsum, 500, 0);
    	$txt->text($toprint);
    	$txt->nl();
    }

    $pdf->saveas("$0.$sname.pdf");
    $pdf->end();
    print STDERR "\n";
   
} # loop of typefaces  Times-Roman, Times-Italic, etc. separate files
exit;

__END__