1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use File::Basename;
7use PDF::Builder;
8use PDF::Builder::Util;
9use PDF::Builder::Win32;
10use Unicode::UCD 'charinfo';
11use Encode qw[:all];
12use Getopt::Long;
13#use Data::Dumper;
14use utf8;
15
16#my $compress = 'none'; # uncompressed streams
17my $compress = 'flate'; # compressed streams
18
19my %wxf = PDF::Builder::Win32->enumwinfonts();
20
21foreach my $k (sort keys %wxf) {
22    print "font '$wxf{$k}' has key '$k'\n";
23
24    my $api = PDF::Builder->new(-compress => $compress);
25
26    $api->mediabox(595,842);
27
28    my $helv = $api->corefont('Helvetica-Bold', -encode=>'latin1');
29
30    my $sx = 33;
31    my $sy = 45;
32    my $fx = 20;
33
34#   my $xf = $api->winfont($k, -encode=>'latin1');
35    my $xf = PDF::Builder::Win32->winfont($k, -encode=>'latin1');
36
37    my $page = $api->page();
38    $page->mediabox(595,842);
39
40    my $gfx = $page->gfx();
41    my $text = $page->text();
42
43    $text->textlabel(50,800, $helv,20, $wxf{$k});
44
45    # row number yp
46    foreach my $yp (0 .. 15) {
47	my $y = 15 - $yp; # row location top to bottom
48	# column number x left to right
49        foreach my $x (0 .. 15) {
50            my $c = $yp*16 + $x;
51            $text->textlabel(50+($sx*$x),50+($sy*$y), $xf,$fx, pack('C',$c));
52            $text->textlabel(50+($sx*$x),50+($sy*$y)-6, $helv,6, nameByUni($c), -color=>'#a00000', -hscale=>80, -rotate=>-15);
53        }
54    }
55
56    if ($xf->can('uniByCId') and $xf->can('glyphNum')) {
57        my @cids = (0 .. $xf->glyphNum()-1);
58        my @fbbx = $xf->fontbbox();
59        my $xw = int(($fbbx[2] - $fbbx[0])/20)*20;
60        my $yw = int(($fbbx[3] - $fbbx[1])/20)*20;
61        my $fw = $xw>$yw? $yw: $xw;
62        my $mw = 800/$fw;
63        my $y0 = int((20 - $fbbx[1])/20)*20*$mw;
64
65	# create pages until run out of cids
66        while (scalar @cids>0) {
67            $page = $api->page();
68            $page->mediabox(595,842);
69
70            $gfx = $page->gfx();
71            $text = $page->text();
72	    my $scale = 0.045;
73
74	    # row positions (y value)
75            foreach my $y (750,700,650,600,550,500,450,400,350,300,250,200,150,100,50) {
76		# column positions (x value)
77                foreach my $x (50,100,150,200,250,300,350,400,450,500) {
78                    my $xo = shift(@cids);
79                    $gfx->save();
80                    $gfx->fillcolor('black');
81                    $gfx->transform(-translate => [$x, $y], -scale => [0.045, 0.045]);
82
83                    $gfx->linewidth(10);
84                    $gfx->rect(0,0, 1000,1000);
85                    $gfx->stroke();
86
87                    my $wx = $xf->wxByCId($xo)*$mw;
88                    my $x0 = (1000-$wx)/2;
89
90                    $gfx->linedash(10,20);
91                    $gfx->linewidth(0.5);
92                    $gfx->move($x0,0);
93                    $gfx->line($x0,1000);
94                    $gfx->move($x0+$wx,1000);
95                    $gfx->line($x0+$wx,0);
96                    $gfx->move(0,$y0);
97                    $gfx->line(1000,$y0);
98                    $gfx->stroke();
99
100                    $text->font($xf, 1000*$mw*$scale);
101                    $text->translate($x+$x0*$scale,$y+$y0*$scale);
102                    $text->add($xf->text_cid(pack('n',$xo)), 'Tj');
103
104                    $text->font($helv, 100*$scale);
105                    $text->hscale(80);
106                    $text->translate($x+25*$scale,$y+860*$scale);
107                    $text->text("G+$xo");
108                    $text->translate($x+25*$scale,$y+10*$scale);
109                    $text->text(sprintf('U+%04X', $xf->uniByCId($xo)));
110
111                    my $name = $xf->glyphByCId($xo);
112                    if ($name eq '') {
113                        $text->fillcolor('red');
114                        $name = "NONE";
115                    } else {
116                        $text->fillcolor('blue');
117                    }
118
119                    $text->hscale(70);
120                    $text->translate($x+975*$scale,$y+860*$scale);
121                    $text->text_right($name);
122
123                    $text->fillcolor('black');
124                    $text->translate($x+975*$scale,$y+10*$scale);
125                    $text->text_right('wx='.$xf->wxByCId($xo));
126
127                    $text->fillcolor('#008000');
128                    $text->translate($x+500*$scale,$y+950*$scale);
129                    $text->hscale(70);
130                    my $ci = charinfo($xf->uniByCId($xo) || 0);
131                    $text->font($helv,50*$scale);
132                    $text->text_center($ci->{'name'});
133
134                    # restore
135		    $text->fillcolor('black');
136		    $text->hscale(100);
137
138                    $gfx->restore();
139
140                    last unless scalar @cids>0;
141                } # next column in row (x pos)
142                last unless scalar @cids>0;
143            } # next row (y pos)
144            print STDERR ".";
145            ## $api->finishobjects($page,$gfx);
146        } # loop through cids
147    } # both uniByCId and glyphNum OK
148
149    $api->saveas("$0.$k.pdf");
150    $api->end();
151} # loop through keys of %wxf
152
153#print Dumper($PDF::Builder::wf);
154
155__END__
156