PostScript-File
view release on metacpan or search on metacpan
lib/PostScript/File.pm view on Meta::CPAN
pop pop exit
} {
/nametype eq {
% Insert the name at EncodePointer
% and increment the pointer.
TempEncode EncodePointer 3 -1 roll put
/EncodePointer EncodePointer 1 add def
} {
% Set the EncodePointer to the number
/EncodePointer exch def
} ifelse
} ifelse
} loop
TempEncode def
} bind def
\n$encoding_def{$encoding}
% Name: Re-encode Font
% Description: Creates a new font using the named encoding.
/REENCODEFONT { % /Newfont NewEncoding /Oldfont
findfont dup length 4 add dict
begin
{ % forall
1 index /FID ne
2 index /UniqueID ne and
2 index /XUID ne and
{ def } { pop pop } ifelse
} forall
/Encoding exch def
% defs for DPS
/BitmapWidths false def
/ExactSize 0 def
/InBetweenSize 0 def
/TransformedChar 0 def
currentdict
end
definefont pop
} bind def
END_FONTS
$fonts .= "\n% Reencode the fonts:\n";
# If no fonts listed, assume the standard ones:
$o->{needed}{font} ||= { map { $_ => 1 } @fonts };
for my $font (sort(keys(%{ $o->{needed}{font} }),
@{ $o->{embed_fonts} })) {
next if $font eq 'Symbol'; # doesn't use StandardEncoding
$fonts .= "/${font}$ext $encoding /$font REENCODEFONT\n";
}
$fonts .= "% end font encoding\n";
} # end if reencode
# Prepare the PostScript file
my $postscript = $o->{eps} ? "\%!PS-Adobe-3.0 EPSF-3.0\n" : "\%!PS-Adobe-3.0\n";
if ($o->{eps}) {
$postscript .= $o->_bbox_comment('', $o->{bbox});
}
if ($o->{headings}) {
require Sys::Hostname;
my $user = getlogin() || (getpwuid($<))[0] || "Unknown";
my $hostname = Sys::Hostname::hostname();
$postscript .= $o->_here_doc(<<END_TITLES);
\%\%For: $user\@$hostname
\%\%Creator: Perl module ${\( ref $o )} v$PostScript::File::VERSION
\%\%CreationDate: ${\( scalar localtime )}
END_TITLES
$postscript .= $o->_here_doc(<<END_PS_ONLY) if (not $o->{eps});
\%\%DocumentMedia: $o->{paper} $o->{width} $o->{height} 80 ( ) ( )
END_PS_ONLY
}
my $landscapefn = "";
$landscapefn .= $o->_here_doc(<<END_LANDSCAPE) if ($landscape);
% Rotate page 90 degrees
% _ => _
/landscape {
$o->{width} 0 translate
90 rotate
} bind def
END_LANDSCAPE
my $clipfn = "";
if ($clipping) {
my $clipcmd = $o->{clipcmd};
$clipcmd = "gsave 0 setgray 0.5 setlinewidth $clipcmd grestore newpath"
if $clipcmd eq 'stroke';
$clipfn .= $o->_here_doc(<<END_CLIPPING);
% Draw box as clipping path
% x0 y0 x1 y1 => _
/cliptobox {
4 dict begin
/y1 exch def /x1 exch def /y0 exch def /x0 exch def
newpath
x0 y0 moveto x0 y1 lineto x1 y1 lineto x1 y0 lineto
closepath
$clipcmd
end
} bind def
END_CLIPPING
} # end if $clipping
my $errorfn = "";
if ($o->{errors}) {
$o->need_resource(font => $o->{errfont});
$errorfn .= $o->_here_doc(<<END_ERRORS);
/errx $o->{errx} def
/erry $o->{erry} def
/errmsg ($o->{errmsg}) def
/errfont /$o->{errfont} def
/errsize $o->{errsize} def
% Report fatal error on page
% _ str => _
/report_error {
0 setgray
errfont findfont errsize scalefont setfont
errmsg errx erry moveto show
80 string cvs errx erry errsize sub moveto show
stop
} bind def
lib/PostScript/File.pm view on Meta::CPAN
our %roman = ();
for (my $i = 1; $i <= $roman_max; $i++) {
$roman{$roman[$i]} = $i;
}
sub incpage_roman ($) { ## no critic (ProhibitSubroutinePrototypes)
my $page = shift;
my $pos = $roman{$page};
return $roman[++$pos];
}
#---------------------------------------------------------------------
sub check_file ($;$$) { ## no critic (ProhibitSubroutinePrototypes)
my ($filename, $dir, $create) = @_;
$create = 0 unless (defined $create);
if (not defined $filename or not length $filename) {
$filename = File::Spec->devnull();
} else {
$filename = check_tilde($filename);
$filename = File::Spec->canonpath($filename);
unless (File::Spec->file_name_is_absolute($filename)) {
if (defined($dir)) {
$dir = check_tilde($dir);
$dir = File::Spec->canonpath($dir);
$dir = File::Spec->rel2abs($dir) unless (File::Spec->file_name_is_absolute($dir));
$filename = File::Spec->catfile($dir, $filename);
} else {
$filename = File::Spec->rel2abs($filename);
}
}
my @subdirs = ();
my ($volume, $directories, $file) = File::Spec->splitpath($filename);
@subdirs = File::Spec->splitdir( $directories );
my $path = $volume;
foreach my $dir (@subdirs) {
$path = File::Spec->catdir( $path, $dir );
mkdir $path unless (-d $path);
}
$filename = File::Spec->catfile($path, $file);
if ($create) {
unless (-e $filename) {
open(my $file, ">", $filename)
or die "Unable to open \'$filename\' for writing : $!\nStopped";
close $file;
}
}
}
return $filename;
}
sub check_tilde ($) { ## no critic (ProhibitSubroutinePrototypes)
my ($dir) = @_;
$dir = "" unless defined $dir;
$dir =~ s{^~([^/]*)}{$1 ? (getpwnam($1))[7] : ($ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7]) }ex;
return $dir;
}
sub array_as_string (@) { ## no critic (ProhibitSubroutinePrototypes)
my $array = "[ ";
foreach my $f (@_) { $array .= "$f "; }
$array .= "]";
return $array;
}
sub str ($) { ## no critic (ProhibitSubroutinePrototypes)
my $arg = shift;
if (ref($arg) eq "ARRAY") {
return array_as_string( @$arg );
} else {
return $arg;
}
}
#---------------------------------------------------------------------
my %special = (
"\n" => '\n', "\r" => '\r', "\t" => '\t', "\b" => '\b',
"\f" => '\f', "\\" => "\\\\", "(" => '\(', ")" => '\)',
);
my $specialKeys = join '', keys %special;
$specialKeys =~ s/\\/\\\\/; # Have to quote backslash
sub pstr {
my $o;
$o = shift if @_ > 1; # We were called as a method
my $string = shift;
my $nowrap = shift; # Pass this ONLY when method call
# Possibly convert \x2D (hyphen-minus) to hyphen or minus sign:
$string = $o->convert_hyphens($string)
if ref $o and $o->{auto_hyphen} and $string =~ /-/;
# Now form the parenthesized string:
$string =~ s/([$specialKeys])/$special{$1}/go;
$string = "($string)";
# A PostScript file should not have more than 255 chars per line:
$string =~ s/(.{240}[^\\])/$1\\\n/g unless $nowrap;
$string =~ s/^([ %])/\\$1/mg; # Make sure it doesn't get stripped
$string;
} # end pstr
sub quote_text
{
my $o;
$o = shift if @_ > 1; # We were called as a method
my $string = shift;
return $string if $string =~ m(^[-+_./*A-Za-z0-9]+\z);
__PACKAGE__->pstr($string, 1);
lib/PostScript/File.pm view on Meta::CPAN
L</auto_hyphen>, L</clipping>, L</eps>, L</extensions>, L</file_ext>,
L</filename>, L</height>, L</incpage_handler>, L</landscape>,
L</langlevel>, L</order>, L</page_label>, L</paper>,
L<strip|/"strip (attribute)">, L</title>, L</version>, and L</width>.
=head3 File size keys
There are four options which control how much gets put into the resulting file.
=head4 debug
=over 6
=item C<undef>
No debug code is added to the file. Of course there must be no calls
to debug functions in the PostScript code. This is the default.
=item C<0>
B<db_> functions are replaced by dummy functions which do nothing.
=item C<1>
A range of functions are added to the file to support debugging PostScript. This switch is similar to the 'C'
C<NDEBUG> macro in that debugging statements may be left in the PostScript code but their effect is removed.
Of course, being an interpreted language, it is not quite the same as the calls still takes up space - they just
do nothing. See L</"POSTSCRIPT DEBUGGING SUPPORT"> for details of the functions.
=item C<2>
Loads the debug functions and gives some reassuring output at the start and a stack dump at the end of each page.
A mark is placed on the stack at the beginning of each page and 'cleartomark' is given at the end, avoiding
potential C<invalidrestore> errors. Note, however, that if the page does not end with a clean stack, it will fail
when debugging is turned off.
=back
=head4 errors
PostScript has a nasty habit of failing silently. If C<errors> is
true, code that prints fatal error messages on the bottom left of the
paper is added to the file. For user functions, a PostScript function
B<report_error> is defined. This expects a message string on the
stack, which it prints before stopping. (Default: true)
=head4 headings
If true, add PostScript DSC comments recording the date of creation and user's
name. (Default: false)
The comments inserted when C<headings> is true are:
%%For: USER@HOSTNAME
%%Creator: Perl module PostScript::File v2.23
%%CreationDate: Sun Jan 1 00:00:00 2012
%%DocumentMedia: US-Letter 612 792 80 ( ) ( )
USER comes from C<getlogin() || getpwuid($<)>, and HOSTNAME comes from
L<Sys::Hostname>. The DocumentMedia values come from the
L<paper size attributes|/"Paper Size and Margins">. The
DocumentMedia comment is omitted from EPS files.
If you want different values, leave C<headings> false and use
L</add_comment> to add whatever you want.
=head4 reencode
Requests that a font re-encode function be added and that the fonts
used by this document get re-encoded in the specified encoding.
The only allowed values are C<cp1252>, C<iso-8859-1>, and
C<ISOLatin1Encoding>. You should almost always set this to C<cp1252>,
even if you are not using Windows.
The list of fonts to re-encode comes from the L</need_fonts> parameter,
the L</need_resource> method, and all fonts added using L</embed_font>
or L</add_resource>. The Symbol font is never re-encoded, because it
uses a non-standard character set.
Setting this to C<cp1252> or C<iso-8859-1> also causes the document to
be encoded in that character set. Any strings you add to the document
that have the UTF-8 flag set will be re-encoded automatically. Strings
that do not have the UTF-8 flag are expected to be in the correct
character set already. This means that you should be able to set this
to C<cp1252>, use Unicode characters in your code and the "-iso"
versions of the fonts, and just have it do the right thing.
Windows code page 1252 (a.k.a. WinLatin1) is a superset of the printable
characters in ISO-8859-1 (a.k.a. Latin1). It adds a number of characters
that are not in Latin1, especially common punctuation marks like the
curly quotation marks, en & em dashes, Euro sign, and ellipsis. These
characters exist in the standard PostScript fonts, but there's no easy
way to access them when using the standard or ISOLatin1 encodings.
L<http://en.wikipedia.org/wiki/Windows-1252>
For backwards compatibility with versions of PostScript::File older
than 1.05, setting this to C<ISOLatin1Encoding> re-encodes the fonts,
but does not do any character set translation in the document.
=head3 Initialization keys
There are a few initialization settings that are only relevant when the file object is constructed.
=head4 bottom
The margin in from the paper's bottom edge, specifying the non-printable area. Remember to specify C<clipping> if
that is what is wanted. (Default: 28)
=head4 clip_command
The bounding box is used for clipping if this is set to "clip" or is drawn with "stroke". This also makes the
whole page area available for debugging output. (Default: "clip").
=head4 font_suffix
This string is appended to each font name as it is re-encoded. (Default: "-iso")
The string value is appended to these to make the new names.
( run in 1.447 second using v1.01-cache-2.11-cpan-140bd7fdf52 )