The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl

use lib '../blib/lib','../blib/arch';
use GD 1.20;
use constant FONT_DIRECTORY => '/dosc/windows/fonts';

my $directory = shift || FONT_DIRECTORY;

my @fonts =  <$directory/*.pfa $directory/*.pfb $directory/*.ttf>;
die "Usage: $0 <directory>\nDisplays a directory of TrueType and Type1 fonts\n" unless @fonts;

my $im = new GD::Image(800,600);
my ($white,$black) =  (
     $im->colorAllocate(255, 255, 255),
     $im->colorAllocate(0, 0, 0));

my ($x,$y) = (20,20);
my $max_x = 0;

for my $font (@fonts) {
  my ($font_name) = $font =~ /([^\\\/]+)$/;
  warn "rendering $font_name\n";
  (my @h = $im->stringTTF($black,$font,12.0,0.0,$x,$y,$font_name)) || next;
  $y = $h[1] + 12 + 5;
  $max_x = $max_x > $h[4] ? $max_x : $h[4];
  if ($y > 600) {
    $y = 20;
    $x = $max_x + 5;
  }
}

binmode STDOUT;

# print the image to stdout
print $im->png;