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