PARM SPOOLFILE,TEXTOUT=$STDLIST, opts=~A

# For example,
#    SPUL2TXT O254833.OUT.HPSPOOL,TEXTOUT
# or SPUL2TXT O254833.OUT.HPSPOOL,TEXTOUT,-s
#  -s strips trailing spaces off lines
#

PURGE SPFTEMP,TEMP  >$null
SETVAR _SPUL2TXT_EOF   FINFO("!SPOOLFILE","EOF")
SETVAR _SPUL2TXT_BYTES FINFO("!SPOOLFILE","BYTEFILESIZE")


IF "!OPTS" = "~A"
  SETVAR _SPUL2TXT_OPTS ""
ELSE
  SETVAR _SPUL2TXT_OPTS "!OPTS"
ENDIF
SETVAR _PERLFILE "-x " + FINFO(HPFILE,"POSIXFULLFNAME")

IF "!TEXTOUT" = "$STDLIST"
  PERL.PUB.PERL "!_PERLFILE !_SPUL2TXT_OPTS !SPOOLFILE" 
ELSEIF LFT("!TEXTOUT",1) = "*"
  PERL.PUB.PERL "!_PERLFILE !_SPUL2TXT_OPTS !SPOOLFILE" >!TEXTOUT
ELSEIF FINFO("!TEXTOUT", 0)
  FILE !TEXTOUT,OLD
  PERL.PUB.PERL "!_PERLFILE !_SPUL2TXT_OPTS !SPOOLFILE" >*!TEXTOUT
  RESET !TEXTOUT
ELSE
  SETVAR _SPUL2TXT_BYTES _SPUL2TXT_BYTES + 1000 + 2*_SPUL2TXT_EOF
  FILE !TEXTOUT;REC=-1,,B,ASCII;DISC=!_SPUL2TXT_BYTES;SAVE
  PERL.PUB.PERL "!_PERLFILE !_SPUL2TXT_OPTS !SPOOLFILE" >*!TEXTOUT
  RESET !TEXTOUT
ENDIF
DELETEVAR _SPUL2TXT@
RETURN
#!perl -w
use Getopt::Std;
use MPE::File;
use strict;

# Ken Hirsch <kenhirsch@myself.com>
#

=pod
Interpreter of carriage control characters.
Handles the most common carriage control directives.
(does not handle "skip to next nth line")

The output of this program might be suitable for input to,
say, txt2pdf, but no promises are made.

=cut

my %opt;
my @cctl;
for (my $i=0; $i<128; $i++) {
  $cctl[$i] = "\n";
}
for (my $i=0321; $i<=0377; $i++) {
  $cctl[$i] = "\n";
}
$cctl[0302] = "\n";
$cctl[ord('-')] = "\n\n\n";
$cctl[ord('0')] = "\n\n";

undef $cctl[ord($_)] for qw(+ 1 2 3);
#undef $cctl[0100];
#undef $cctl[0101];

my $savedspaces = 0;
my $lastprintlength = 0;
my $currentline = 0;

getopts("fFl:s", \%opt);

my $keepspaces= $opt{s} || 0;
my $formfeed =  $opt{f} || $opt{F} || 0;
my $pagelen =    $opt{l} || 60;

binmode(STDOUT);

my $filename = $ARGV[0] or die usage();
my $f = MPE::File->new($filename, 3, 3, 15, 1)    # MR multirec
   or die "$0: Cannot open $filename: $MPE_error\n";
my $block='';
my $blocklen;

# Spool File Block Format is documented in 
# Native Mode Spooler Reference Manual, Appendix A

# The meaning of the carriage-control codes is documented
# under FWRITE in the Intrinsics Reference Manual

# http://docs.hp.com/mpeix/all/

my $trailingspaces = 0;
my $lineonpage = 1;

while ($blocklen = $f->fread($block, -1024)) {
  my $ptr = 0;
  my $phylen;
  while ($ptr < $blocklen && 
        ($phylen = unpack("s", substr($block, $ptr, 2))) > 0) {
    $ptr += 2;
    $phylen += 1 if $phylen & 1;  # round up odd byte lengths
    my ($loglen, $func, $p1, $p2) = 
               unpack "S4", substr($block, $ptr, 8);
    # print STDERR "loglen=$loglen  func=$func  p1=$p1  p2=$p2\n";
    my $data = $ptr + 8;
    $ptr += $phylen;
    if ($func == 1) {
      my $datalen = $phylen - 8;
      my $implied;
      if ($loglen > $datalen) {
        $implied = $loglen - $datalen;
        $loglen = $datalen;
      } else {
        $implied = 0;
      }
      printline($p1, $p2, $implied, substr($block, $data, $loglen));
    }
  }
}


sub printline {
  my ($p1, $p2, $impliedspaces, $line) = @_;
  my $cc;
  my $prespacing = $p2 & 1;

#  printf "printline(%d, %d, %d, (%d), %s)\n",
#     $p1, $p2, $impliedspaces, ord($line), $line;
#     return;

  if ($p1 == 1) {
    $cc = ord($line);
    $line = substr($line, 1);
  } else {
    $cc = $p1;
  }
  if ($prespacing) {
    docctl($cc)
  }
  if ($keepspaces) {
    $line .= " " x $impliedspaces if $impliedspaces
  } else {
    if ($line =~ s/( +)$//) {
      $impliedspaces += length($1);
    }
    $savedspaces = $impliedspaces;
  }

  print $line;
  $lastprintlength = length($line);

  if (! $prespacing) {
    docctl($cc);
  }
}

sub docctl {
  my $cc = shift;
  my $linefeeds = $cctl[$cc];
  if (defined $linefeeds) {
    # print "linefeeds[$cc] = ", length($linefeeds), "\n";
    print $linefeeds;
    $currentline += length($linefeeds);
  } elsif ($cc >= 0200 && $cc <= 0277) {
    $linefeeds = $cc - 0200;
    # print "linefeeds[$cc] = $linefeeds\n";
    print "\n" x $linefeeds;
    $currentline += $linefeeds;
  } elsif ($cc == 053) {
    print "\r";
  } elsif ($cc == 0320) {
    print ' ' x $savedspaces;
  } elsif ($cc >= 061 && $cc <= 063) {
    $currentline = $currentline % $pagelen;
    # print "Conditional page current = $currentline\n";
    if ($currentline == 0 && $lastprintlength == 0) {
      # return;
    } elsif ($formfeed) {
      print "\f";
    } else {
      print "\n" x ($pagelen - $currentline);
    }
    $currentline = 0;
  } elsif ($cc == 0300 || $cc == 0313) {
    if ($formfeed) {
      print "\f";
    } else {
      print "\n" x ($pagelen - $currentline);
    }
    $currentline = 0;
  } elsif ($cc == 0301 || $cc == 0310) {
    $currentline = $currentline % $pagelen;
    print "\n" x ($pagelen - 1 - $currentline);
    $currentline = $pagelen - 1;
  } elsif ($cc == 0311 || $cc == 0312) {
    $currentline = $currentline % $pagelen;
    print "\n" x ($pagelen - 2 - $currentline);
    $currentline = $pagelen - 2;
  } elsif ($cc >= 0305 || $cc <= 0307) {
    my $targ;
    $currentline = $currentline % $pagelen;
    if ($cc == 0305) {
      $targ = $pagelen/2;
    } elsif ($cc == 0306) {
      $targ = $pagelen/4;
    } elsif ($cc == 0307) {
      $targ = $pagelen/6;
    }
    my $diff = ($targ - ($currentline % $targ));
    print "\n" x $diff;
    $currentline += $diff;
  } else {
    print "\n";
    ++$currentline;
  }
  $savedspaces = 0;
}