summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl')
-rw-r--r--Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl120
1 files changed, 120 insertions, 0 deletions
diff --git a/Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl b/Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl
new file mode 100644
index 00000000000..38574176ce4
--- /dev/null
+++ b/Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl
@@ -0,0 +1,120 @@
+#!/usr/bin/env perl
+use strict;
+$^W=1;
+# pst-geo-uncompress.pl
+# Copyright (C) 2009 Heiko Oberdiek.
+#
+# This work may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.3
+# of this license or (at your option) any later version.
+# The latest version of this license is in
+# http://www.latex-project.org/lppl.txt
+# and version 1.3 or later is part of all distributions of LaTeX
+# version 2005/12/01 or later.
+#
+# This work has the LPPL maintenance status `maintained'.
+#
+# The Current Maintainer of this work is Heiko Oberdiek.
+#
+# See file "README" for a list of files that belong to this project.
+my $file = "pst-geo-uncompress.pl";
+my $program = uc($&) if $file =~ /^\w+/;
+my $version = "1.0";
+my $date = "2009/07/30";
+my $author = "Heiko Oberdiek";
+my $copyright = "Copyright (c) 2009 by $author.";
+# History:
+# 2009/07/30 v1.0: First release.
+my $title = "$program $version, $date - $copyright\n";
+print STDERR $title;
+my $prg_gs = "gs";
+$prg_gs = "gs386" if $^O =~ /dos/i;
+$prg_gs = "gsos2" if $^O =~ /os2/i;
+$prg_gs = "gswin32c" if $^O =~ /mswin32/i;
+$prg_gs = "gswin32c" if $^O =~ /cygwin/i;
+$prg_gs = "mgs" if defined($ENV{"TEXSYSTEM"}) and
+ $ENV{"TEXSYSTEM"} =~ /miktex/i;
+
+$::opt_help = 0;
+
+my $usage = <<"END_OF_USAGE";
+Function: Compresses data files for pst-geo
+Syntax: $0 <input file> [output file]
+If the output file is not given, standard output is used.
+Options: (defaults:)
+ --help print usage
+ --gscmd <name> call of ghostscript ($prg_gs)
+END_OF_USAGE
+use Getopt::Long;
+GetOptions(
+ "help!",
+ "gscmd=s" => \$prg_gs
+) or die $usage;
+!$::opt_help or die $usage;
+
+(@ARGV == 1 or @ARGV == 2) or die $usage;
+
+my $input = $ARGV[0];
+my $output = $ARGV[1];
+
+open(IN, '<', $input) or die "!!! Error: Cannot open file `$input'!\n";
+my $header = <IN> . <IN>;
+$header =~ /^%!PS\s+(.*)currentfile((<<[^>]+>>)?\/[\w\d]+ filter) cvx exec\s*$/s
+ or die "!!! Error: Unknown file format of `$input'!\n";
+my $decode = $2;
+my $pos = tell(IN);
+my $ps_input = unpack 'H*', $input;
+my $ps_output = '';
+my $ps_output = unpack 'H*', $output if $output;
+
+my $ps_code = <<"END_PS_CODE";
+%!PS
+/buf 10000 string def
+<$ps_input> (r) file
+dup $pos setfileposition
+$decode
+END_PS_CODE
+$ps_code .= <<"END_PS_CODE" if $output;
+<$ps_output> (w) file
+exch
+END_PS_CODE
+$ps_code .= <<"END_PS_CODE";
+{ dup buf readstring exch
+END_PS_CODE
+$ps_code .= <<"END_PS_CODE" unless $output;
+ print
+END_PS_CODE
+$ps_code .= <<"END_PS_CODE" if $output;
+ 3 index exch writestring
+END_PS_CODE
+$ps_code .= <<"END_PS_CODE";
+ not {exit} if
+} loop
+closefile
+END_PS_CODE
+$ps_code .= <<"END_PS_CODE" if $output;
+closefile
+END_PS_CODE
+$ps_code .= <<"END_PS_CODE";
+quit
+%%EOF
+END_PS_CODE
+my @cmd = (
+ $prg_gs,
+ '-q',
+ '-sDEVICE=nullpage',
+ '-dBATCH',
+ '-c',
+ $ps_code
+);
+system @cmd;
+if ($? & 127) {
+ die sprintf "!!! Error: Ghostscript died with signal %d!\n",
+ ($? & 127);
+}
+elsif ($? != 0) {
+ die sprintf "!!! Error: Ghostscript exited with error code %d!\n",
+ $? >> 8;
+}
+print STDERR "* `$output' written.\n" if $output;
+__END__