use warnings;
use strict;
use PDF::Reuse;
my %stdFont =
( 'Times-Roman' => 'Times-Roman',
'Times-Bold' => 'Times-Bold',
'Times-Italic' => 'Times-Italic',
'Times-BoldItalic' => 'Times-BoldItalic',
'Courier' => 'Courier',
'Courier-Bold' => 'Courier-Bold',
'Courier-Oblique' => 'Courier-Oblique',
'Courier-BoldOblique' => 'Courier-BoldOblique',
'Helvetica' => 'Helvetica',
'Helvetica-Bold' => 'Helvetica-Bold',
'Helvetica-Oblique' => 'Helvetica-Oblique',
'Helvetica-BoldOblique' => 'Helvetica-BoldOblique',
'Symbol' => 'Symbol',
'ZapfDingbats' => 'ZapfDingbats',
'TR' => 'Times-Roman',
'TB' => 'Times-Bold',
'TI' => 'Times-Italic',
'TBI' => 'Times-BoldItalic',
'C' => 'Courier',
'CB' => 'Courier-Bold',
'CO' => 'Courier-Oblique',
'CBO' => 'Courier-BoldOblique',
'H' => 'Helvetica',
'HB' => 'Helvetica-Bold',
'HO' => 'Helvetica-Oblique',
'HBO' => 'Helvetica-BoldOblique',
'S' => 'Symbol',
'Z' => 'ZapfDingbats');
my ($line, $string);
my $x = 25;
my $y = 710;
my ($xDim, $yDim, $xScale, $yScale, $pdf);
my $file = shift;
my $i = 1;
prFile('myFile.pdf');
prFontSize(7);
while (1)
{ my @vec = prForm( { file => $file,
page => $i,
effect => 'add',
tolerant => 1 });
my $form = $vec[0];
if ($form eq '0')
{ last;
}
if ($form)
{ $xDim = $vec[3] - $vec[1];
$yDim = $vec[4] - $vec[2];
$xScale = 100 / $xDim;
$yScale = 100 / $yDim;
if ($xScale < $yScale)
{ $yScale = $xScale;
}
else
{ $xScale = $yScale;
}
$string = "q\n";
$string .= "$xScale 0 0 $yScale $x $y cm\n"; # scale and "move to"
$string .= "/$form Do\n";
$string .= "Q\n";
prAdd($string);
}
else
{ prText($x, ($y + 70), 'Can\'t be used by prForm.');
prText($x, ($y + 60), 'Concatenate the streams.');
prText($x, ($y + 50), 'Look at the documentation');
prText($x, ($y + 40), 'for "prForm" how that can');
prText($x, ($y + 30), 'be done ! Or use prDoc or');
prText($x, ($y + 20), 'prSinglePage');
$xDim = 0;
$yDim = 0;
}
$line = 'Form : ' . $file . ' ' . $i . ' D: ' . $xDim . ' X ' . $yDim;
prText($x, ($y - 15), $line);
move();
my $j = 0;
my $images = $vec[5];
while ($j < $images)
{ $j++;
my ($iName, $width, $height) = prImage({ file => $file,
page => $i,
imageNo => $j,
effect => 'add' } );
if (($width < 101) && ($height < 101))
{ $xDim = $width;
$yDim = $height;
}
else
{
$xScale = 100 / $width;
$yScale = 100 / $height;
if ($xScale < $yScale)
{ $yScale = $xScale;
}
else
{ $xScale = $yScale;
}
$xDim = $xScale * $width;
$yDim = $yScale * $height;
}
$string = "q\n";
$string .= "$xDim 0 0 $yDim $x $y cm\n"; # scale and "move to"
$string .= "/$iName Do\n";
$string .= "Q\n";
prAdd($string);
$line = 'Image :' . $file . ' ' . $i . ' ' . $j . ' D: '
. $width . ' X ' . $height;
prText($x, ($y - 15), $line);
move();
}
$i++;
}
$x = 25;
$y -= 40;
if ($y < 100)
{ prPage();
$y = 710;
}
prFontSize(20);
prFont('TR');
prText($x, $y, 'Found "non-standard" fonts: ');
$y -= 40;
my ($intnamn, $extnamn, $oldIntNamn, $oldExtNamn, $f) = prFont();
my %font;
for my $font (keys %{$f})
{ if (exists $font{$font})
{ next;
}
if ($y < 100)
{ prPage();
$y = 710;
}
if (! exists $stdFont{$font})
{ my @list = prFont($font);
if ($list[1] eq $font)
{ prFontSize(18);
prFont('TR');
prText($x, $y, "$font :");
$y -= 25;
prFontSize(10);
prFont($font);
prText($x, $y, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ!"#$%&\'()*+-./0123456789:;<=>?@');
$y -= 14;
prText($x, $y, 'abcdefghijklmnopqrstuvwxyz{|}~\305\304\326\345\344\366[\]^_ยด`');
$y -= 40;
}
}
# $font{$font}++;
}
prEnd();
sub move
{ if ($x > 400)
{ $x = 25;
$y -= 120;
}
else
{ $x += 200;
}
if ($y < 0)
{ prPage();
$x = 25;
$y = 710;
}
}
__END__
=head1 AUTHOR
Lars Lundberg larslund@cpan.org
Chris Nighswonger cnighs@cpan.org
=head1 COPYRIGHT
Copyright (C) 2003 - 2004 Lars Lundberg, Solidez HB.
Copyright (C) 2005 Karin Lundberg.
Copyright (C) 2006 - 2010 Lars Lundberg, Solidez HB.
Copyright (C) 2010 - 2014 Chris Nighswonger
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.