#!/usr/local/bin/perl -w

# xt-to-t - convert NSA cross-table to John Chew's .t file

# Copyright (C) 2002 by John J. Chew, III <jjchew@math.utoronto.ca>

sub Main ();
sub Report ($$$);

Main;

sub Main () {
  my $id = undef;
  my $offset = 0;
  my %notional_scores = ('W' => 2, 'L' => 0, 'T' => 1);
  my $unrated = 0;
  my $rated = 0;
  while (<>) {
    my $save = $_;
    if (s/^\s+(\d+)\.\s+//) {
      my $newid = $1;
      if ($newid == 1) {
        $offset += $id if defined $id;
        }
      elsif ((defined $id) && ($id+1 != $newid)) {
        die "Player number error: $save\nAborting.\n";
        }
      $id = $newid;
      }
    elsif (/^(?:<|\s+OLD|\s+NAME|\s*$)/) { # headings and HTML tags
      Report $ARGV, $rated, $unrated;
      next;
      }
    else { # tournament name
      s/^\s+//;
      s/\s+$//;
      print '# ', $_, "\n";
      next;
      }
    unless (s/^([- A-Z]+), ([- A-Z]*[A-Z])\s+//) {
      die "Can't find player name at $. in $ARGV: $save\nAborting.\n";
      }
    my $name = "$2 $1";
    s/^(\d+)  //;
    my $initr = $1 || 0;
    if ($initr) { $rated++; } else { $unrated++; }
    my (@pairings, @scores);
    while (s/^ ?([WLT ])-(\d+|  ) //) {
      if ($1 eq ' ') {
        push(@pairings, 0);
	push(@scores, 50);
	}
      else {
        push(@pairings, $2 + $offset);
	push(@scores, $notional_scores{$1});
        }
      }
    die "Can't parse last four columns ($_): $save\nAborting"
      unless /^\s*\d+\+?\s+[-+]?\d+(?:\s+-?\d+)?\s+(\d+)\s*$/;
    print "# player:$name;$initr;$1\n";
    printf "%-20s %4d %s; %s\n",
      $name,
      $initr,
      join(' ', @pairings),
      join(' ', @scores);
    }
  continue {
    if (eof) { Report $ARGV, $rated, $unrated; close(ARGV); }
    }
  }

sub Report ($$$) {
  return unless $_[1] + $_[2];
  warn "$_[0] has $_[1] rated and $_[2] unrated players in a division.\n" 
    if 0;
#   if $_[2];
  $_[1] = 0;
  $_[2] = 0;
  }