#!/usr/bin/perl -w

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

use strict;
use warnings;

use lib qw{ ../lib };
use PDF::Builder;
use PDF::Builder::Util;
use Unicode::UCD 'charinfo';

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

# Note that to display the resulting PDF, many users will have to install
# "East Asian" font package(s) for their browser. This is normally an easy
# "one-button" process.

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, sed quia consequuntur magni dolores eos, qui ratione voluptatem sequi nesciunt, neque porro quisquam est, qui dolorem ipsum, quia dolor sit, amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt, ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit, qui in ea voluptate velit esse, quam nihil molestiae consequatur, vel illum, qui dolorem eum fugiat, quo voluptas nulla pariatur? At vero eos et accusamus et iusto odio dignissimos ducimus, qui blanditiis praesentium voluptatum deleniti atque corrupti, quos dolores et quas molestias excepturi sint, obcaecati cupiditate non provident, similique sunt in culpa, qui officia deserunt mollitia animi, id est laborum et dolorum fuga. Et harum quidem rerum facilis est et expedita distinctio. Nam libero tempore, cum soluta nobis est eligendi optio, cumque nihil impedit, quo minus id, quod maxime placeat, facere possimus, omnis voluptas assumenda est, omnis dolor repellendus. Temporibus autem quibusdam et aut officiis debitis aut rerum necessitatibus saepe eveniet, ut et voluptates repudiandae sint et molestiae non recusandae. Itaque earum rerum hic tenetur a sapiente delectus, ut aut reiciendis voluptatibus maiores alias consequatur aut perferendis doloribus asperiores repellat.|;

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

my ($pdf, $f1, $gfx, $text, $page);
# font name list
my @fontnames = qw[ 
  Ming Ming-Bold Ming-Italic Ming-BoldItalic
  Song Song-Bold Song-Italic Song-BoldItalic
  MyungJo MyungJo-Bold MyungJo-Italic MyungJo-BoldItalic
  KozMin KozMin-Bold KozMin-Italic KozMin-BoldItalic
  KozGo KozGo-Bold KozGo-Italic KozGo-BoldItalic 
];

# 'short' (-s flag)?
if (@ARGV > 0 && $ARGV[0] eq '-s') {
    @fontnames = qw[
      KozGo  Ming-Bold
    ];
}

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

foreach my $fn (@fontnames) {
   #if ($fn eq 'Ming-Bold') { last; } # for testing

    $pdf = PDF::Builder->new(-compress => $compress, -file => "$0.$fn.pdf");

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

    print STDERR "\n$fn\n";

    my $font = $pdf->cjkfont($fn);
    $font->tounicodemap();
    my @cids = (0 .. $font->glyphNum()-1);
    # WARNING: apparently not all fonts include a fontbbox entry
    my @fbbx = $font->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;
    my $scale = 0.045;

    while (scalar @cids>0) {
        $page = $pdf->page();
        $page->mediabox(595,842);

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

	# loop through rows (y) top to bottom
        foreach my $y (750,700,650,600,550,500,450,400,350,300,250,200,150,100,50) {
	    # loop through columns (x) left to right
            foreach my $x (50,100,150,200,250,300,350,400,450,500) {
                my $xo = shift(@cids);
                $gfx->save();
                $gfx->transform(-translate => [$x, $y], -scale => [0.045, 0.045]);

		# draw cell box 1000x1000 user units
                $gfx->linewidth(10);
                $gfx->rect(0,0, 1000,1000);
                $gfx->stroke();

                my $wx = $font->wxByCId($xo)*$mw;
                my $x0 = (1000 - $wx)/2;

		# dashed lines for baseline, left and right limits
                $gfx->linedash(10,20);
                $gfx->linewidth(0.5);
                $gfx->move($x0,0);
                $gfx->line($x0,1000);       # left limit
                $gfx->move($x0+$wx,1000);
                $gfx->line($x0+$wx,0);      # right limit
                $gfx->move(0,$y0);
                $gfx->line(1000,$y0);       # baseline
                $gfx->stroke();

                $text->font($font, 1000*$mw*$scale);
                $text->translate($x+$x0*$scale,$y+$y0*$scale);
                $text->add($font->text_cid(pack('n',$xo)),'Tj');

                $text->font($f1, 80*$scale);
                $text->hscale(80);
                $text->translate($x+25*$scale,$y+810*$scale);
                $text->text("G+$xo"); 
                $text->translate($x+25*$scale,$y+10*$scale);
		my $fontValue = $font->uniByCId($xo);
		if (defined $fontValue) {
                  $text->text(sprintf('U+%04X',$fontValue));
		} else {
                  $text->text('U+????');
		}
                $text->translate($x+975*$scale,$y+10*$scale);
                $text->text_right('wx='.$font->wxByCId($xo));

                my $ci = charinfo($font->uniByCId($xo) || 0);
                my $name = $font->glyphByCId($xo);

                if ($name =~ m|^uni[0-9a-f]{4}$|io) {
                    $text->fillcolor('red');
                    $name = $ci->{'name'} || "NONE";
                } else {
                    $text->fillcolor('blue');
                }
                $text->translate($x+975*$scale,$y+910*$scale);
                $text->hscale(70);
                $text->text_right($name);

		# restore
		$text->hscale(100);
		$text->fillcolor('black');

                $gfx->restore();

                last unless scalar @cids>0;
            } # column loop x coordinates
            last unless scalar @cids>0;
        } # row loop y coordinates
        print STDERR ".";
        $pdf->finishobjects($page,$gfx);
    } # while loop until run out of cids

    my $textL = $LoremIpsum;

    $page = $pdf->page();
    $page->mediabox(595,842);
    $text = $page->text();
    $text->transform(-translate => [50, 800]);
    $text->fillcolor('black');
    $text->font($font, 18);
    $text->leading(18*1.25);
    my $toprint;
    while($textL ne '') {
    	($toprint, $textL) = $text->_text_fill_line($textL, 500, 0);
    	$text->text($toprint);
    	$text->nl();
    }
    
    $pdf->save();
    $pdf->end();
} # while loop, done with this font. repeat with next
print STDERR "\n";

exit;

__END__

=head1 HISTORY

    $Log$
    Revision 2.1  2007/04/07 10:28:35  areibens
    added lorem ipsum page

    Revision 2.0  2005/11/16 02:16:00  areibens
    revision workaround for SF cvs import not to screw up CPAN

    Revision 1.2  2005/11/16 01:27:48  areibens
    genesis2

    Revision 1.1  2005/11/16 01:19:24  areibens
    genesis

    Revision 1.3  2005/09/12 16:55:05  fredo
    various updates

    Revision 1.2  2004/12/31 02:59:35  fredo
    no message

    Revision 1.1  2004/04/06 23:08:57  fredo
    genesis


=cut
