#!/afs/sipb/project/perldev/p -w

use strict;
use FileHandle;

my $in = '/afs/athena.mit.edu/user/m/a/map/Die/playerlist.ps';
my $out = '/mit/bert/ps/die'; # things will get appended to this

$in = shift @ARGV  if @ARGV;
$out = shift @ARGV if @ARGV;

{
  @ARGV = ($in);

  # add structured comments, so we can use 'psnup -n1x2 -r die.ps'
  my $structured = new FileHandle "$out.ps", 'w'
    or die "open $out.ps: $!";

  print $structured "%!PS-Adobe-1.0\n";

  while (<>) {
    $_ = reparen($_) if /^\(/;   # (foo (bar) baz) is legal but hard to parse;
                                 # make it (foo \(bar\) baz)
    s/(Aviation Company Reps)/uc($1)/e;		# Die!-specific hack
#    / dagger/ and ($_ = "% $_");		# debugging: no dagger

    print $structured $_ unless /^%!/;
    /^%%Orientation:/
      and print $structured "%%Pages: 2\n";
    /^% Begin first page/
      and print $structured "%%EndProlog\n%%Page: 1 1\n";
    /^% Begin second page/
      and print $structured "%%Page: 2 2\n";
  }
  print $structured "%%Trailer\n";
}

### second filter

{
  # generate a sorted-by-name list

  @ARGV = ("$out.ps");

  my $byName = new FileHandle "$out-n.ps", 'w'
    or die "open $out-n.ps: $!";
  my $byLast = new FileHandle "$out-l.ps", 'w'
    or die "open $out-l.ps: $!";

 HDR:
  while (<>) {
    print $byName $_;
    print $byLast $_;
    /^%%EndProlog/ && last HDR;
  }

  my %nlist = ();
  my %llist = ();
  my ($full, $name, $last, $rest);

  while (<>) {
    next if /^%/ or /^HEADER$/ or /^\s*$/ or /^showpage$/
      or /\(Game Master\)/;
    /^\(((:?[^\)]|\\\))*[^\)\\])?\)/ or die "eek: $_";
    if (length($1)) {
      ($full, $rest) = ($1, $');

      if ($full =~ /^[-A-Z ]*$/) {
	undef $name;
	undef $last;
      } else {
	$name = $full;
	$name =~
	  s/# match titles
	    ^(Rev\.|General|Col\.|Maj\.|Capt\.|Lt\.|Sgt\.|Cpl\.|Doc)
	      \s+
	     (.*)$  # match rest of name
	   /$2, $1/x;
	die "repeat: $name" if $nlist{$name};
	$nlist{$name} = [ "($name) $rest" ];

	$last = $full;
	$last =~ s/^(.*)\s+(\S+)$/$2, $1/;
	die "repeat: $last" if $llist{$last};
	$llist{$last} = [ "($last) $rest" ];
      }
    } else {
      push @{$nlist{$name}}, $_
	unless /^\(\) \(\) \(\) \(\) \(\) \(\)/;
      push @{$llist{$last}}, $_
	unless /^\(\) \(\) \(\) \(\) \(\) \(\)/;
    }
  }

  my $maxcnt = 60;
  my ($cnt, $page);

  $cnt = 0;   $page = 1;
  print $byName "%%Page: 1 1\nHEADER\n\n";
  foreach (sort keys %nlist) {
    $cnt += scalar @{$nlist{$_}};
    if ($cnt > $maxcnt) {
      $cnt = 0;  $page++;
      print $byName "\nshowpage\n%%Page: $page $page\nHEADER\n\n";
    }
    print $byName join('', @{$nlist{$_}});
  }
  print $byName "\nshowpage\n%%Trailer\n";

  $cnt = 0;   $page = 1;
  print $byLast "%%Page: 1 1\nHEADER\n\n";
  foreach (sort keys %llist) {
    $cnt += scalar @{$llist{$_}};
    if ($cnt > $maxcnt) {
      $cnt = 0;  $page++;
      print $byLast "\nshowpage\n%%Page: $page $page\nHEADER\n\n";
    }
    print $byLast join('', @{$llist{$_}});
  }
  print $byLast "\nshowpage\n%%Trailer\n";
}


sub reparen {
  local($_) = @_;
  my ($out) = '';
  my ($level) = 0;
  my ($body);

  # match any of \\, \(, \), (, ).
  # we only really care about ( and ), but others are needed to parse right.
  while (/\\\\|\\\(|\\\)|\(|\)/) {
    $body = $&;
    ($body eq '(') and ($level++ and $body = '\(');
    ($body eq ')') and (--$level and $body = '\)');
    $out .= $` . $body;
    $_ = $';
  }
  $out . $_;
}