psutils/fixpspps.pl

   1 @PERL@
   2 # mangle PostScript produced by PSPrint to make it almost conforming
   3 #
   4 # Copyright (C) Angus J. C. Duggan 1991-1995
   5 # See file LICENSE for details.
   6
   7 $header = 1; $ignore = 0;
   8 $verbose = 0;
   9 @body = ();
  10 %fonts = (); $font = "";
  11 $inchar = 0; @char = ();
  12
  13 while (<>) {
  14    if (/^\@end$/) {
  15       $ignore = 1;
  16    } elsif (/^[0-9]+ \@bop0$/) {
  17       $ignore = 0;
  18       $header = 1;
  19    } elsif ($header) {
  20       if (/^\/([a-z.0-9]+) \@newfont$/) {
  21          if (! defined($fonts{$1})) {
  22             $fonts{$1} = 1;
  23             print;
  24          } elsif ($verbose) {
  25             print STDERR "$font already defined\n";
  26          }
  27       } elsif (/^([a-z.0-9]+) sf$/) {
  28          $font = $1;
  29          print;
  30       } elsif (/^\[</) {
  31          $inchar = 1;
  32          push (@char, $_);
  33       } elsif ($inchar) {
  34          push (@char, $_);
  35          if (/.*\] ([0-9]+) dc$/) {
  36             if (! defined($fonts{$font,$1})) {
  37                $fonts{$font,$1} = 1;
  38                print (@char);
  39             } elsif ($verbose) {
  40                print STDERR "$font character $1 already defined\n";
  41             }
  42             $inchar = 0;
  43             @char = ();
  44          }
  45       } elsif (/^([0-9]+) \@bop1$/) {
  46          $header = 0;
  47          push (@body, "%%Page: ? $1\n");
  48          push (@body, $_);
  49       } else {
  50          print;
  51       }
  52    } elsif (! $ignore) {
  53       push (@body, $_);
  54    }
  55 }
  56 print (@body);
  57 print ("\@end\n");
  58 @END@