#!/usr/bin/perl -w

## tsh - tournament shell
## Copyright (C) 1998-2003 by John J. Chew, III.

# TODO show *draws* if we're sure they draw
# TODO finish adding active/inactive support (P1324, KOTH, RoundRobin, DoClark)
# TODO document recent changes
# TODO mark players active/inactive
# TODO pair using firsts and seconds
# TODO extend support for 9999 = no score yet

## Version history
#
# 2.840 NSSC
#   Fixed a bug introduced in 2.800 (?) where missing pairs were duplicated
# 2.830 NSSC
#   Slightly more readable and conformant HTML code
# 2.820 NSSC
#   Corrected determination of firsts and seconds
# 2.810 NSSC
#   WC and SC automatically measure max player name width
#   $config'assign_firsts
#   @config'external_path
#   %config'externals
#   $config'max_name_length
#   $config'name_format
#   MISSING and SP show "draws" if players must draw
#   'off' extension field for '.t' files
#   partial support for active/inactive players
#   hooks for external commands
# 2.800 NSSC
#   ES prompts with current scorecard before each command
#   added FIRST and SECOND subcommands to ES
#   MISSING and SP show p12 order if available
#   added "config track_firsts" configuration option to track 1sts & 2nds
#   Partially paired divisions can still be completed with autopair
#   Added tsh.config 'config' command
#   P1324 automatically assigns byes
#   KOTH automatically assigns byes
#   NS automatically assigns byes
#   BYE command replaced by PAIR and A
#   SP command doesn't list everyone if there aren't any pairings
#   PAIR command only reports changes
#   un-documented deprecated commands: SW PRESW PSW PPSW
#   added ES subcommand to A (goes into edit mode on last-entered score)
#   recorrected ES bug that sometimes discarded changes
#   corrected diagnostics emitted by UPR command
#   corrected documentation of P1324 command
#   InitFontes doesn't emit spurious errors with <8 players in division
#   several command argument parsers rewritten
#   RoundStandings reports results in partial current round correctly
#   division name doesn't have to be omitted in 1-division events
#   randomization of orderings made less so for stable table assignments
#   some spurious warnings deleted
#   support for new generalized .t files
#   HTML output from pairings command
# 2.740 Newsday SSC
#   'PairMany' command debugged 
# 2.730 Newsday SSC
#   'ShowPair' command reports more problems
# 2.720 Newsday SSC
#   'PairMany' command
# 2.710 Newsday SSC
#   Player names may include nonterminal numerals
# 2.700 Newsday SSC
#   HTML output from standings command
# 2.600 Oshawa 2005
#   'RoundRobin' command
#   'RATings' command
# 2.500 MWMST 2004
#   trying to autopair a round twice doesn't crash tsh.pl
# 2.400 Albany 2004
#   fixed 'wc -f #'
#   autopair works at start of tournament
#   missing lists divisions in alphabetical order
#   'm' synonym for 'missing' in score entry mode
# 2.300 BAT 2004
#   autopair
#   editscores emits updated scorecard
# 2.210 Montreal QC 2004-03 club tournament
#   suppressed a spurious error message
# 2.200 Cambridge ON 2004
#   "cambridge pairings"
# 2.100 CNSC 2003
#   Addscore gives updated cumes as a check
# 2.000 MWMST 2003
#   'missing' lists missing data in score entry mode
#   teed log files have '.doc' extension, no embedded spaces
# 1.900 CWSCQT 2003
#   added ShowPairings -p as kludge to work with make-rr.pl
# 1.800 Albany 2003
#   scorecard shows opp ratings
#   unpairround reports on problem players
#   table numbers can be arbitrary strings 
#   entering a division name changes divisions in score entry mode
#   ShowWallChart -f r lists beginning with round r only
# 1.700 Boston 2003
#   EditScore added
#   NewSwiss code added, first manually paired player can be 0 for an unscored bye pairing
# 1.600 Boston 2001
#   InitFontes works for any number of players, not just 4n and 4n+2
# 1.500 Toronto 2001
# 1.400 Boston 2001
# 1.300 Danbury 2001
# 1.200 incorporates 2000 CNSC changes
# 1.103 version used at 1999 Toronto SCRABBLE Tournament
# 1.000 first release

# TODO: printing support

use strict;
use Carp;

## libraries

unshift(@::INC, "$::ENV{'HOME'}/lib/perl") if defined $::ENV{'HOME'};
# require 'dawg.pl';

## global constants

if ($^O eq 'MacOS') { $config'backup_directory = ':old:'; }
else { $config'backup_directory = './old/'; }
$config'max_name_length = 22;
$config'name_format = '%-22s';
@config'external_path = qw(./bin ../bin);
my $gkVersion = '2.840';

## prototypes

sub CheckAutoPair ($$);
sub CheckRoundHasResults ($$);
sub ChooseBye ($$$);
sub CmdAddScore ($$);
sub CmdBye ($$);
sub CmdCambridgePair ($$);
sub CmdDeleteScore ($$);
sub CmdEditScore ($$);
sub CmdEval ($$);
sub CmdExternal ($$);
sub CmdHelp ($$);
sub CmdInitFontes ($$);
sub CmdKOTH ($$);
sub CmdLook ($$);
sub CmdMissing ($$);
sub CmdNewSwiss ($$);
sub CmdPair ($$);
sub CmdPair1324 ($$);
sub CmdPairMany ($$);
sub CmdPartialSwiss ($$);
sub CmdPreSwiss ($$);
sub CmdPrePreSwiss ($$);
sub CmdQuit ($$);
sub CmdRandomScores ($$);
sub CmdRatings ($$);
sub CmdResultsByRound ($$);
sub CmdRoundRobin ($$);
sub CmdRoundStandings ($$);
sub CmdShowWallChart ($$);
sub CmdShowScoreCard ($$);
sub CmdStandings ($$);
sub CmdSwiss ($$);
sub CmdUnpairRound ($$);
sub CountByes ($);
sub DefineExternal ($$$);
sub DoClark (\%$);
sub DoNewSwiss ($$$);
sub DoSwiss ($$$$;$);
sub FormatPairing ($$$;$);
sub GetAllPlayers ($);
sub GetRegularUnpaired ($$);
sub GetUnpaired ($;$);
sub GetUnpairedRound ($$);
sub lint ();
sub Main ();
sub log_pairings ($$);
sub log_standings ($$);
sub log_ratings ($);
sub log_wc ($);
sub ParseArgs ($$);
sub ParseDivisionName ($$);
sub ParseInteger ($$$$$);
sub ParseNothing ($$);
sub ParseNRounds ($$);
sub ParseRepeats ($$);
sub ParseRoundNumber ($$);
sub Prompt ();
sub ReadConfig ();
sub ReadDivision (\%);
sub ReadDivisions ();
sub Recursive_Swiss ($$);
sub ReopenConsole ();
sub ReportHeader ($);
sub ReportTrailer ();
sub ResolvePairings ($$);
sub SortByStanding ($@);
sub SpliceInactive (\@;$);
sub SynchDivision ($);
sub SynchFirsts ($);
sub TaggedName ($);
sub UpdateDivisions ($);
sub WriteDivision ($);

## data structures
# %gDivision maps division names to division data hashes
# division data hashes contain the following:
#
#   data        array of player data, 1-based indexing
#   file        filename of .t file
#   maxp        highest round number that has pairings data (0-based)
#   maxs        highest round number that has score data (0-based)
#   maxs_player the name of a player who has a score in round maxs
#   name        division name
#
# player data (in $gDivision{$div}{data}) is a list mapping 
# 1-based player ID to a hash mapping:
#
#   division    pointer to division
#   etc         supplementary player data (see below)
#   id          player ID (1-based) # not sure this is still here
#   name        player name
#   opp         provisional opponent used within pairing routines
#   p1          number of firsts (starts)
#   p2          number of seconds (replies)
#   p3          number of indeterminates (starts/replies)
#   pairings    list of opponent IDs by round (0-based by round, 1-based IDs)
#   ratedgames  number of rated games
#   ratedwins   number of rated wins
#   rating      pre-tournament rating
#   repeats     data structure tracking repeat pairings
#   rnd         pseudorandom value used to break ties in standings
#   rspread     cumulative spread by round
#   rwins       cumulative wins by round
#   scores      list of this player's scores by round (0-based)
#   spread      cumulative spread
#   tspread     temporary spread variable used in CmdResultsByRound
#   twins       temporary wins variable used in CmdResultsByRound
#   wins        number of wins
#
# supplementary player data
#
#   off         exists if player is inactive, single value indicates
#               type of byes (-50/0/50) to be assigned
#   p12         0-based list, 1 if went first, 2 if second, 0 if neither (bye),
#               3 if must draw, 4 if indeterminate

## global variables

%global'commands = (
  'a' => \&CmdAddScore,
  'addscore' => \&CmdAddScore,
  'bye' => \&CmdBye,
  'camp' => \&CmdCambridgePair,
  'cambridgepair' => \&CmdCambridgePair,
  'deletescore' => \&CmdDeleteScore,
  'delete' => \&CmdDeleteScore,
  'done' => \&CmdQuit,
  'es' => \&CmdEditScore,
  'editscore' => \&CmdEditScore,
  'exit' => \&CmdQuit,
  'eval' => \&CmdEval,
  'help' => \&CmdHelp,
  'koth' => \&CmdKOTH,
  'if' => \&CmdInitFontes,
  'initfontes' => \&CmdInitFontes, 
  'l' => \&CmdLook,
  'look' => \&CmdLook,
  'missing' => \&CmdMissing,
  'ns' => \&CmdNewSwiss,
  'newswiss' => \&CmdNewSwiss,
  'pair' => \&CmdPair,
  'pairmany' => \&CmdPairMany,
  'p1324' => \&CmdPair1324,
  'pair1324' => \&CmdPair1324,
  'partialswiss' => \&CmdPartialSwiss,
  'pm' => \&CmdPairMany,
  'ppsw' => \&CmdPrePreSwiss,
  'prepreswiss' => \&CmdPrePreSwiss,
  'presw' => \&CmdPreSwiss,
  'preswiss' => \&CmdPreSwiss,
  'psw' => \&CmdPartialSwiss,
  'q' => \&CmdQuit,
  'quit' => \&CmdQuit,
  'rand' => \&CmdRandomScores,
  'rat' => \&CmdRatings,
  'rate' => \&CmdRatings,
  'ratings' => \&CmdRatings,
  'rbr' => \&CmdResultsByRound,
  'roundrobin' => \&CmdRoundRobin,
  'rr' => \&CmdRoundRobin,
  'resultsbyround' => \&CmdResultsByRound,
  'rs' => \&CmdRoundStandings,
  'roundstandings' => \&CmdRoundStandings,
  'randomscores' => \&CmdRandomScores,
  'sc' => \&CmdShowScoreCard,
  'showscorecard' => \&CmdShowScoreCard,
  'sp' => \&CmdShowPairings,
  'showpair' => \&CmdShowPairings,
  'showpairs' => \&CmdShowPairings,
  'showpairings' => \&CmdShowPairings,
  'showwallchart' => \&CmdShowWallChart,
  'st' => \&CmdStandings,
  'standings' => \&CmdStandings,
  'sw' => \&CmdSwiss,
  'swiss' => \&CmdSwiss,
  'upr' => \&CmdUnpairRound,
  'unpairround' => \&CmdUnpairRound,
  'wc' => \&CmdShowWallChart,
  '?' => \&CmdHelp,
  ';' => \&CmdEval,
  );
my %gDivision;
my $gKeyRound = undef;
my $gNDivisions;
my (@gPrompt) = ('tsh> ');

sub bystanding { 
#  die ("Incomplete player $a->{'name'} ($a):\n  ".join(', ',keys %$a)."\n")
#    unless defined $a->{'wins'} && defined $a->{'spread'} 
#    && defined $a->{'rating'} && defined $a->{'rnd'};
  confess unless defined $gKeyRound;
  local($^W) = 0;
# TODO: should check previous rounds if no data yet for gKeyRoundw
  $gKeyRound >= 0 ? 
  (($b->{'rwins'}[$gKeyRound]||$b->{'wins'})<=>($a->{'rwins'}[$gKeyRound]||$a->{'wins'}) ||
  (($b->{'rspread'}[$gKeyRound]||$b->{'spread'})<=>($a->{'rspread'}[$gKeyRound]||$a->{'spread'})) || 
  $b->{'rating'}<=>$a->{'rating'} ||
  $b->{'rnd'}<=>$a->{'rnd'})
  : ($b->{rating}<=>$a->{rating} || $b->{rnd} <=> $a->{rnd})
  ; }

sub by_current_standing {
  $b->{wins} <=> $a->{wins} ||
  $b->{spread} <=> $a->{spread} ||
  $b->{rating} <=> $a->{rating} ||
  $b->{rnd} <=> $a->{rnd};
  }
  
sub by_initial_standing {
  $b->{rating} <=> $a->{rating} ||
  $b->{rnd} <=> $a->{rnd};
  }

sub CheckAutoPair ($$) {
  my $dp = shift;
  my $round = shift;
  my $datap = $dp->{'data'};
  my $round0 = $round - 1; # internally, rounds are zero-based
# print "Checking AutoPair.\n";
  # first look to see if there are any unpaired 
  # TODO: check to see if this duplicates one of the sub Get...s
  my @unpaired;
  for my $p (@$datap[1..$#$datap]) {
    push(@unpaired, $p) if $p && !defined $p->{'pairings'}[$round0];
    }
  return unless @unpaired;
  my $apdp = $config'autopair{uc $dp->{'name'}}[$round];
  return unless $apdp;
  my (@apd) = @{$apdp};

  my $sr = shift @apd;
  my $sr0 = $sr - 1;
  # check to see if all results are in for the source round
  if ($sr) {
    for my $p (@unpaired) {
      unless (defined $p->{'scores'}[$sr0]) {
	print "Can't yet autopair division $dp->{'name'} round $round:\n- missing a score for $p->{'name'} (and maybe others) in round $sr.\n";
	return 0;
	}
      }
    }
  my $system = $apd[0];
  # check to see we aren't going too far ahead
  if ($round0 != $dp->{'minp'} + 1) { # everyone has at least minp pairings
    my $mp1 = $dp->{'minp'} + 1 + 1;
    print "Can't autopair round $round; next round to pair is $mp1.\n";
    return 0;
    }
  print "Auto-pairing.\n";
# # if unpaired are odd, choose a bye player
# if (@unpaired % 2 && $system !~ /^if$/i) {
#   ChooseBye $dp, $round0, $sr0;
#   }
  # unpaired are now even, apply required pairing system
  if ($system =~ /^(?:if)$/i) {
    CmdInitFontes \@apd, "@apd";
    }
  elsif ($system =~ /^(?:ns|newswiss)$/i) {
    CmdNewSwiss \@apd, "@apd";
    }
  elsif ($system =~ /^(?:koth)$/i) {
    CmdKOTH \@apd, "@apd";
    }
  elsif ($system =~ /^(?:rr|roundrobin)$/i) {
    CmdRoundRobin \@apd, "@apd";
    }
  else { die "Unknown pairing system '$system'"; }
  }
  
sub CheckRoundHasResults ($$) {
  my $sr0 = shift;
  my $dp = shift;
  if ($sr0 > $dp->{'maxs'}) {
    my $sr = $sr0+1;
    print "You don't have round $sr results yet.\n";
    return 0;
    }
  return 1;
  }

# ChooseBye $dp, $round0, $sr0
#
# Assign a bye in division $dp, round $round0+1, based on round $sr0+1 standings

sub ChooseBye ($$$) {
  my $dp = shift;
  my $round0 = shift;
  my $sr0 = shift;
  my $datap = $dp->{'data'};

  # look for lowest ranked player with minimum byes
  my $minbyes = CountByes $dp;
  my $p = (SortByStanding $sr0, GetAllPlayers $dp)[-1]
    or die "Tried to choose a bye but couldn't find any players?!";
  $p->{'pairings'}[$round0] = 0;
# warn "Not sure assigning bye score is a good idea.\n";
# $p->{'scores'}[$round0] = 50;
  print "Gave a bye to $p->{'name'}.\n";
# print join(',', %$p), "\n";
  # We have to call SynchDivision to update maxp
  SynchDivision $dp;
  # This is always called before a pairing system call, so we don't
  # have to WriteDivision
  }

sub CmdAddScore ($$) { my($argvp, $args) = @_;
  my ($round, $dp) = ParseArgs $argvp, [qw(round division)];
  return 0 unless defined $dp;
  if ($round == 0)
    { print "Can't add scores for round 0.\n"; return 0; }
  my $datap = $dp->{'data'};

  my %dirty = ();
  my $lastpn1 = 1;
  while (1) {
    print "[$dp->{'name'}${round}]:pn1 ps1 pn2 ps2? ";
    local($_) = scalar(<STDIN>);
    s/\s+$//;
    if (defined $gDivision{lc $_}) {
      $dp = $gDivision{lc $_};
      $datap = $dp->{'data'};
      last unless defined $datap;
      next;
      }
    elsif (/^(?:m|missing)$/i) {
      CmdMissing ['AddScore', $round], '';
      next;
      }
    elsif (/^(?:es|editscore)$/i) {
      UpdateDivisions \%dirty;
      CmdEditScore ['AddScore', $dp->{'name'}, $lastpn1, $round], '';
      next;
      }
    last if /[^-\d\s]/;
    my (@words) = split;
    if (@words == 2) {
      my ($pn1, $ps1) = @words;
      if ($pn1 < 1 || $pn1 > $#$datap) { 
	print "There is no player #$pn1.\n";
	next;
	}
      my $pp1 = $datap->[$pn1];
      my $opp1 = $pp1->{'pairings'}[$round-1];
      unless ((defined $opp1) && $opp1 == 0) {
	print "$pp1->{'name'} did not have a bye in round $round.\n";
	next;
        }
      if ($pp1->{'scores'}[$round-1] && $pp1->{'scores'}[$round-1] != 9999) {
	print "$pp1->{'name'} already has a score ($pp1->{'scores'}[$round-1]).\n";
	next;
	}
      {
	my $wlt = (($ps1 <=> 0) + 1) / 2;
	printf "#%d %s %+d (%.1f %+d).\n",
	  $pp1->{id}, 
	  $pp1->{name}, 
	  $ps1,
	  $pp1->{wins} + $wlt,
	  $pp1->{spread} + $ps1,
	  ;
      }
      $lastpn1 = $pn1;
      $dirty{$dp->{name}}++;
      $pp1->{'scores'}[$round-1] = $ps1;
      next;
      }
    last unless @words == 4;
    my ($pn1, $ps1, $pn2, $ps2) = @words;
    if ($pn1 < 1 || $pn1 > $#$datap) {
      print "There is no player #$pn1.\n";
      next;
      }
    if ($pn2 < 1 || $pn2 > $#$datap) {
      print "There is no player #$pn2.\n";
      next;
      }
    my $pp1 = $datap->[$pn1];
    my $pp2 = $datap->[$pn2];
    if ($pp1->{'pairings'}[$round-1] ne $pn2) {
      print "$pp1->{'name'} and $pp2->{'name'} did not play each other in round $round.\n";
      next;
      }
    if ($pp1->{'scores'}[$round-1] && $pp1->{'scores'}[$round-1] != 9999) {
      print "$pp1->{'name'} already has a score.\n";
      next;
      }
    if ($pp2->{'scores'}[$round-1] && $pp2->{'scores'}[$round-1] != 9999) {
      print "$pp2->{'name'} already has a score.\n";
      next;   
      }
    if ($config'track_firsts) {
      my $p12p = $pp1->{'etc'}{'p12'};
      my $old = $p12p->[$round-1];
      if ($old && $old == 2) 
        { print "$pp1->{'name'} was supposed to go second.\n"; }
      $p12p->[$round-1] = 1;

      $p12p = $pp2->{'etc'}{'p12'};
      $old = $p12p->[$round-1];
      if ($old && $old == 1) 
        { print "$pp2->{'name'} was supposed to go first.\n"; }
      $p12p->[$round-1] = 2;
      }
    {
      my $spread = $ps1 - $ps2;
      my $wlt = (($spread <=> 0) + 1) / 2;
      printf "#%d %s %d (%.1f %+d) - #%d %s %d (%.1f %+d).\n",
        $pp1->{id}, 
        $pp1->{name}, 
	$ps1,
	$pp1->{wins} + $wlt,
	$pp1->{spread} + $spread,
        $pp2->{id}, 
        $pp2->{name}, 
	$ps2,
	$pp2->{wins} + 1 - $wlt,
	$pp2->{spread} - $spread,
	;
    }
    $lastpn1 = $pn1;
    $dirty{$dp->{name}}++;
    $pp1->{'scores'}[$round-1] = $ps1;
    $pp2->{'scores'}[$round-1] = $ps2;
    }
  UpdateDivisions \%dirty;
  0;
  }

# TODO: fix pairings for opponents of bye player
sub CmdBye ($$) { my ($argvp, $args) = @_;
  my $usage = "Usage: BYE p1 score round [division]\n";
  my ($p1, $score, $round, $dp) 
    = ParseArgs $argvp, [qw(player-number score round division)];
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};

  print "The BYE command has replaced by PAIR and A.\n";
  $round--;

  $^W = 0;
  my $p1pair = $datap->[$p1]{'pairings'};
  printf "%s used to be paired to %s\n", 
    (TaggedName $datap->[$p1]), 
    (TaggedName $datap->[$p1pair->[$round]])
    if $p1pair->[$round];
  $^W = 1;
  $p1pair->[$round] = 0;
  $datap->[$p1]{'scores'}[$round] = $score;
    
  SynchDivision $dp;
  WriteDivision $dp;
  0;
  }
  
# Semi-fixed seven-round pairings used in Cambridge ON
sub CmdCambridgePair ($$) { my ($argvp, $args) = @_;
  my ($dp) = ParseArgs $argvp, [qw(division)];
  return 0 unless defined $dp;
  if ($dp->{'maxp'} != -1) 
    { print "Division already has pairings.\n"; return 0; }
  print "Calculating Cambridge pairings for Division $dp->{'name'}.\n";

  my $datap = $dp->{'data'};
  if ($#$datap == 6) { for my $i (6,5,4,3,2) { DoClark %$dp, $i; } }
  elsif ($#$datap == 8) { for my $i (8,7,6,5,4,3,2) { DoClark %$dp, $i; } }
  elsif ($#$datap == 10) { for my $i (10,8,7,5,4,2) { DoClark %$dp, $i; } }
  elsif ($#$datap == 12) { for my $i (12,10,8,6,4,2) { DoClark %$dp, $i; } }
  elsif ($#$datap == 14) { for my $i (14,12,10,8,4,2) { DoClark %$dp, $i; } }
  elsif ($#$datap == 16) { for my $i (16,14,11,8,5,2) { DoClark %$dp, $i; } }
  elsif ($#$datap == 18) { for my $i (18,15,12,9,6,3) { DoClark %$dp, $i; } }
  elsif ($#$datap == 20) { for my $i (20,17,14,11,8,5){ DoClark %$dp, $i; } }
  elsif ($#$datap == 22) { for my $i (22,18,14,10,6,2){ DoClark %$dp, $i; } }
  # my generalisation
  elsif ($#$datap % 2 == 0 && $#$datap > 22) {
    my $delta = int($#$datap / 6);
    my $opp1 = $#$datap;
    for my $i (1..6) {
      DoClark %$dp, $opp1;
      $opp1 -= $delta;
      }
    }
  else {
    print "Don't know how to do Cambridge pairings for this division size.\n";
    }
  SynchDivision $dp;
  WriteDivision $dp;
  0;
  }
  
# TODO: should permit deleting byes
sub CmdDeleteScore ($$) { my($argvp, $args) = @_;
  my ($pn1, $s1, $pn2, $s2, $round, $dp) 
    = ParseArgs $argvp, 
      [qw(player-number score player-number score round division)];
  return 0 unless defined $dp;

  my $pp1 = $dp->{'data'}[$pn1];
  my $pp2 = $dp->{'data'}[$pn2];
  if ($pp1->{'pairings'}[$round-1] ne $pn2) {
    print "$pp1->{'name'} and $pp2->{'name'} did not play each other in round $round.\n";
    return 0;
    }
  if ($pp1->{'scores'}[$round-1] != $s1) {
    print "$pp1->{'name'}'s score was $pp1->{'scores'}[$round-1], not $s1.\n";
    return 0;
    }
  if ($pp2->{'scores'}[$round-1] != $s2) {
    print "$pp2->{'name'}'s score was $pp2->{'scores'}[$round-1], not $s2.\n";
    return 0;
    }
  if ($#{$pp1->{'scores'}} == $round-1) {
    pop @{$pp1->{'scores'}};
    }
  else {
    print "Warning: that wasn't $pp1->{'name'}'s most recent score.\n";
    $pp1->{'scores'}[$round-1] = 0;
    }
  if ($#{$pp2->{'scores'}} == $round-1) {
    pop @{$pp2->{'scores'}};
    }
  else {
    print "Warning: that wasn't $pp2->{'name'}'s most recent score.\n";
    $pp2->{'scores'}[$round-1] = 0;
    }
  print "Deleted scores.\n";
  SynchDivision $dp;
  WriteDivision $dp; 
  0;
  }

sub CmdEditScore ($$) { my ($argvp, $args) = @_;
  my ($dp, $id, $round) = ParseArgs $argvp, 
      [qw(division player-number round)];
  return 0 unless defined $round;
  my $datap = $dp->{'data'};
  my $p = $datap->[$id];
  unless (defined $p) { print "No such player: $id.\n"; return 0; }
  unless (defined $p->{'scores'}[$round-1]) 
    { print "Player doesn't yet have scores in round $round.\n"; return 0; }

  my %dirty;
  while (1) {
    CmdShowScoreCard ['sc', $dp->{'name'}, $id], "sc $dp->{'name'} $id";
    my $oppid = $p->{'pairings'}[$round-1];
    if (!defined $oppid) {
      print "$p->{'name'} has no opponent in round $round.\n";
      last;
      }
    my $opp = $datap->[$oppid];
    my $ms = $p->{'scores'}[$round-1] || 0;
    my $os = $oppid && $opp->{'scores'}[$round-1] || 0;

    print "Enter: D div, R round, P player, FIRST, SECOND or corrected score(s).\n";
    if ($oppid) {
      my $vs = FormatPairing $dp, $round-1, $id, 'half';
      print "$p->{'name'} ($dp->{'name'}$id) R$round [$ms $os $vs] ";
      }
    else {
      print "$p->{'name'} ($dp->{'name'}$id) R$round [bye scoring $ms] ";
      }
    local($_) = scalar(<STDIN>);
    s/^\s+//; s/\s+$//;
    if (/^d\s+(\S+)$/) {
      my $newdp = $gDivision{lc $1};
      if (defined $newdp) { 
        $dp = $newdp;
        $datap = $dp->{'data'};
        $p = $datap->[$id];
	$p = $datap->[$id = 1] unless defined $p;
	unless (defined $p->{'scores'}[$round-1]) {
	  print "No corresponding scores in division $dp->{'name'}\n";
	  return 0;
	  }
        }
      else {
        print "No such division.\n";
        }
      }
    elsif (/^r\s+([1-9]\d*)$/) {
      $round = $1;
      }
    elsif (/^p\s+([1-9]\d*)$/) {
      my $newid = $1;
      my $newp = $datap->[$newid];
      if (!defined $newp) {
        print "No such player.\n";
        }
      elsif (!defined $newp->{'scores'}[$round-1]) {
        print "Player has no scores in round $round.\n";
        }
      else {
        $p = $newp;
        $id = $newid;
        }
      }
    elsif (/^(first|second)$/i) {
      unless ($oppid) {
	print "Player had a bye, went neither first nor second.\n";
	next;
        }
      for my $etcp ($p->{'etc'}, $opp->{'etc'}) {
	if ($#{$etcp->{'p12'}} < $round-1) {
	  print "Please record earlier firsts and seconds first.\n";
	  next;
	  }
        }
      if (/^first$/i) {
	$p->{'etc'}{'p12'}[$round-1] = 1;
	$opp->{'etc'}{'p12'}[$round-1] = 2;
        }
      else {
	$p->{'etc'}{'p12'}[$round-1] = 2;
	$opp->{'etc'}{'p12'}[$round-1] = 1;
        }
      $dirty{$dp->{name}}++;
      }
    elsif ($oppid && /^(-?\d+)\s+(-?\d+)$/) {
      $p->{'scores'}[$round-1] = $1;
      $opp->{'scores'}[$round-1] = $2 if $oppid;
      $dirty{$dp->{name}}++;
      }
    elsif ((!$oppid) && /^(-?\d+)$/) {
      $p->{'scores'}[$round-1] = $1;
      $dirty{$dp->{name}}++;
      }
    else {
      last;
      }
    }
  UpdateDivisions \%dirty;
  0;
  }
  
sub CmdEval ($$) {
  my($argvp, $args) = @_;
  $args =~ s/^(;|eval)\s//i;
  print join("\n", eval $args);
  print "\n\$\@: '$@'\n";
  0;
  }

sub CmdExternal ($$) {
  my($argvp, $args) = @_;
  my $arg0 = $argvp->[0];
  my $cmdp = $config'externals{$arg0};
  if (defined $cmdp) {
    my $args = $cmdp->{'args'};
    my (@argv) = ParseArgs $argvp, $args;
    pop @argv; # there's a '1' at the end, from ParseNothing
    # TODO: everyone else should use the new global'parse_error too
    return 0 if $global'parse_error;
    for my $arg (@argv) {
      $arg = $arg->{file} if ref($arg) eq 'TSH::Division';
      }
    system $cmdp->{file}, @argv;
    }
  }

sub CmdHelp ($$) {
  print <<'EOS';
Commands Available:

Addscore r d                 add new scores
BYE p1 s1 r d                register a bye
CAMbridgePair d              set up seven-round pairings for Cambridge ON
DELETEscore p1 s1 p2 s2 r d  delete scores 
EditScore d p1 r             begin editing scores
EVAL code                    evaluate arbitary perl code
HELP                         print this message
InitFontes nr d              fixed-pair division for nr rounds to boot Fontes pairings
KOTH rpt sr d                add king-of-the-hill pairings
Look word                    look up 'word' in dictionary
MISSING r                    list players for whom score is missing in round r
NewSwiss rpt sr d            New Swiss-pair division using round sr results
PAIR p1 p2 r d               manually pair p1 and p2 together
Pair1324 rpt sr d            pair 1-3, 2-4, 5-7, 6-8 etc.
PairMany r d                 make several pairings changes at once
Quit                         quit
RANDomscores d               give each player a random score (for testing)
RATings d                    show division standings with ratings estimates
ResultsByRound r1-r2 d       rank players based only on rounds r1-r2
RoundRobin d                 add a full round robin to a division
RoundStandings r d           show standings after given round
showScoreCard d p1           show correct scorecard for checking
ShowPair r d                 show pairings
STandings d                  show current standings
showWallChart d              show correct wall chart for checking
UnPairRound r d              delete pairings

Notes:
- You can type the whole command name or just the part in caps
- 'd' stands for a division name, 'r' for a round number
- 'sr' stands for a 'source round' on which pairings are to be based
- 'p1' and 'p2' are player numbers, 's1' and 's2' are scores
- 'rpt' specifies how many times two players can repeat pairings
EOS
  0;
  }

sub CmdInitFontes ($$) { my ($argvp, $args) = @_;
  my ($nrounds, $dp) = ParseArgs $argvp, [qw(nrounds division)];
  return 0 unless defined $dp;
  if ($dp->{'maxp'} != -1) 
    { print "Can't do pre-Fontes pairings, division already has some pairings.\n"; return 0; }
  print "Calculating initial pre-Fontes pairings for Division $dp->{'name'}.\n";

  # calculate pairings
  if ($nrounds == 3) {
    my @rrs = ();
    my $sortedp = GetUnpaired $dp;
    SpliceInactive @$sortedp, 3;
    @$sortedp = sort by_initial_standing @$sortedp;
    my $np = $#$sortedp + 1;
    if ($np < 4) { print "$np is not enough players: must have at least four.\n"; return 0; }
    if ($np % 4) { # players don't divide exactly into quads
      my @oddballs;
      my @formats;
      if ($np % 4 == 1) { # number of players is 1 (mod 4)
        # pick five players one from each quintile
	# TODO: think about avoiding giving byes to top seeds
        for (my $section=4; $section>=0; $section--) {
          push(@oddballs, splice(@$sortedp, int($np*($section+rand(1))/5),1));
          }
        @formats = ([3,4,undef,0,1],[1,0,3,2,undef],[undef,2,1,4,3]);
        }
      elsif ($np % 4 == 2) { # number of players is 2 (mod 4)
        # pick six players one from each sextile
        for (my $section=5; $section>=0; $section--) {
          push(@oddballs, splice(@$sortedp, int($np*($section+rand(1))/6),1));
          }
        @formats = ([5,2,1,4,3,0],[3,4,5,0,1,2],[1,0,3,2,5,4]);
        }
      elsif ($np % 4 == 3) { # number of players is 3 (mod 4)
	# TODO: think about avoiding giving byes to top seeds
        # pick three players one from each third
        for (my $section=2; $section>=0; $section--) {
          push(@oddballs, splice(@$sortedp, int($np*($section+rand(1))/3),1));
          }
        @formats = ([2,undef,0],[1,0,undef],[undef,2,1]);
        }
#     print "[", join(',', map($_->{'id'}, @oddballs)), "]\n";
      for my $format (@formats) {
            for my $i (0..$#$format) {
               my $opp = $format->[$i];
               $opp = defined $opp ? $oddballs[$opp]{'id'} : 0;
               push(@{$oddballs[$i]{'pairings'}}, $opp);
                }
        }
      }
    # at this point, number of remaining players in @$sortedp is divisible by four.
    if ($#$sortedp % 4 != 3) { die "Assertion failed."; }
    # repeatedly pick one random player from each quartile
    for (my $n4 = int(@$sortedp/4); $n4 > 0; $n4--) {
      my @rr = ();
# print "sortedp:[", join(',', map($_->{'id'}, @$sortedp)), "]\n";
      for (my $quartile = 3; $quartile >= 0; $quartile--) {
        push(@rr, splice(@$sortedp, $quartile*$n4 + rand($n4), 1));
        }
      push(@rrs, \@rr);
      }
    # assign pairings
    for my $rr (@rrs) {
#     print "[", join(',', map($_->{'id'}, @$rr)), "]\n";
      if ($#$rr == 3) {
        # RR4 gets paired 14.23, 13.24, 12.34
        for my $format ([3,2,1,0],[2,3,0,1],[1,0,3,2]) {
          for my $i (0..3) {
            push(@{$rr->[$i]{'pairings'}}, $rr->[$format->[$i]]{'id'});
            }
          }
        }
      }
    SynchDivision($dp);
    WriteDivision($dp);
    }
  else { 
    print "The only implemented number of rounds so far is 3, not $nrounds.\n";
    }
  return 0;
  }
  
sub CmdKOTH ($$) { my($argvp, $args) = @_;
  my ($repeats, $sr, $dp) 
    = ParseArgs $argvp, [qw(repeats based-on-round division)];
  return 0 unless defined $dp;
  my $sr0 = $sr-1;
  CheckRoundHasResults $sr0, $dp or return 0;
  print "Calculating King-Of-The-Hill pairings for Division $dp->{'name'} based on round $sr.\n";
  
  my $sortedp = (GetRegularUnpaired $dp, $sr0);
  printf "Players to be paired: %d\n", $#$sortedp+1;
  return unless @$sortedp;
  die "Assertion failed" unless @$sortedp % 2 == 0;
  @$sortedp = SortByStanding $sr0, @$sortedp;

  { my $n = $#$sortedp; for my $i (0..$n) {
    my $p = $sortedp->[$i];
    my @pref = ();
    for my $j (1..$n) {
      {
	my $k = $i+$j;
	my $opp = $sortedp->[$k];
	push (@pref, $opp) if $k <= $n && $p->{'repeats'}[$opp->{'id'}] <= $repeats;
      }
      {
	my $k = $i-$j;
	my $opp = $sortedp->[$k];
	push (@pref, $opp) if $k >=0 && $p->{'repeats'}[$opp->{'id'}] <= $repeats;
      }
      } # for $j
    $p->{'pref'} = \@pref;
    } # for $i
  } # my $n
  if (ResolvePairings $dp, $sortedp) {
    SynchDivision $dp;
    WriteDivision $dp;
    }
  0;
  }
  
sub CmdLook ($$) {
  my ($argvp) = @_;
  shift @$argvp;

  print "The word lookup feature is not enabled in this copy.\n";
  my $ok = 1;
# for my $word (@$argvp) {
#   if (&dawg'check(*TWL98, lc $word)) { print "'$word' is acceptable.\n"; }
#   else { print "'$word' is not acceptable.\n"; $ok = 0; }
#   }
# printf "The play is%s acceptable.\n", $ok ? '' : ' not';
  0;
  }

# TODO: should report table number (this involves orthogonalizing a function that maps (d,p,r) to (b,t)
sub CmdMissing ($$) { my($argvp, $args) = @_;
  my ($round) = ParseArgs $argvp, [qw(round)];
  return 0 unless defined $round;
  my $round0 = $round-1;
  
  for my $dp (sort { $a->{'name'} cmp $b->{'name'} } values %gDivision) {
    my @done = ();
    my $datap = $dp->{'data'};
    for my $i (1..$#$datap) {
      next if $done[$i];
      if (!defined $datap->[$i]{'scores'}[$round0]) {
        my $opp = $datap->[$i]{'pairings'}[$round0];
	if ($opp) {
	  unless (defined $datap->[$opp]{'scores'}[$round0]) {
	    print FormatPairing $dp, $round0, $i;
	    }
          $done[$opp] = 1;
	  }
	else {
	  print TaggedName $datap->[$i];
	  }
        print "\n";
        }
      }
    }
  0;
  }
 
sub CmdNewSwiss ($$) { my($argvp, $args) = @_;
  my ($repeats, $sr, $dp) 
    = ParseArgs $argvp, [qw(repeats based-on-round division)];
  return 0 unless defined $dp;
  my $sr0 = $sr-1;
  CheckRoundHasResults $sr0, $dp or return 0;
  print "Calculating Swiss pairings for Division $dp->{'name'} based on round $sr, $repeats repeats allowed.\n";

  DoNewSwiss $dp, $repeats, $sr0;
  0;
  }
  
# TODO: fix pairings for opponents of repaired players
sub CmdPair ($$) { my ($argvp, $args) = @_;
  my ($p1, $p2, $round, $dp) 
    = ParseArgs $argvp, [qw(player-number-or-0 player-number round division)];
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};

  for my $p ($p1,$p2) {
    unless ($p <= $#$datap) { print "No such player: $p\n"; return 0; }
    }

  $round--;

  my $p1pair = $datap->[$p1]{'pairings'} if $p1;
  my $p2pair = $datap->[$p2]{'pairings'} if $p2;
  printf "%s used to be paired to %s\n", 
    (TaggedName $datap->[$p1]), 
    (TaggedName $datap->[$p1pair->[$round]])
    if $p1 && defined $p1pair->[$round] && $p2 != $p1pair->[$round];
  printf "%s used to be paired to %s\n", 
    (TaggedName $datap->[$p2]), 
    (TaggedName $datap->[$p2pair->[$round]])
    if defined $p2pair->[$round] && $p1 != $p2pair->[$round];
  $p1pair->[$round] = $p2 if $p1;
  $p2pair->[$round] = $p1 if $p2;
    
  SynchDivision $dp;
  WriteDivision $dp;
  0;
  }

sub CmdPair1324 ($$) { my($argvp, $args) = @_;
  my ($repeats, $sr, $dp)
    = ParseArgs $argvp, [qw(repeats based-on-round division)];
  return 0 unless defined $dp;
  my $sr0 = $sr - 1;
  CheckRoundHasResults $sr0, $dp or return 0;

  print "Calculating 1324 pairings for Division $dp->{'name'} based on round $sr.\n";

  my $sortedp = (GetRegularUnpaired $dp, $sr0);
  die "Assertion failed" unless @$sortedp % 2 == 0;
  @$sortedp = SortByStanding $sr0, @$sortedp;

  { my $n = $#$sortedp; for my $i (0..$n) {
    my $p = $sortedp->[$i];
    my @pref = ();
    for my $j (2,1,3..$n) {
      {
	my $k = $i+$j;
	my $opp = $sortedp->[$k];
	push (@pref, $opp) if $k <= $n && $p->{'repeats'}[$opp->{'id'}] <= $repeats;
      }
      {
	my $k = $i-$j;
	my $opp = $sortedp->[$k];
	push (@pref, $opp) if $k >=0 && $p->{'repeats'}[$opp->{'id'}] <= $repeats;
      }
      } # for $j
    $p->{'pref'} = \@pref;
    } # for $i
  } # my $n
  if (ResolvePairings $dp, $sortedp) {
    SynchDivision $dp;
    WriteDivision $dp;
    }
  0;
  }
  
# TODO: fix pairings for opponents of repaired players
sub CmdPairMany ($$) { my ($argvp, $args) = @_;
  my ($round, $dp) = ParseArgs $argvp, [qw(round division)];
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};

  my %dirty = ();
  while (1) {
    print "[$dp->{'name'}${round}]:pn1 pn2? ";
    local($_) = scalar(<STDIN>);
    s/\s+$//;
    if (defined $gDivision{lc $_}) {
      $dp = $gDivision{lc $_};
      $datap = $dp->{'data'};
      last unless defined $datap;
      next;
      }
    elsif (/^\s*r\s*(\d+)\s*$/i) {
      $round = $1;
      next;
      }
    last if /[^-\d\s]/;
    my (@pns) = split;
    last if @pns != 2;
    my $errors = 0;
    for my $i (0..1) {
      my $pn = $pns[$i];
      my $oppn = $pns[1-$i];
      if ($pn > $#$datap) {
	print "There is no player #$pn.\n";
	$errors++;
	next;
        }
      next unless $pn;
      my $pp = $datap->[$pn];
      my $oldoppn = $pp->{'pairings'}[$round-1];
      if (defined $oldoppn) {
	next if $oldoppn == $oppn;
	print "#$pn $pp->{'name'} used to be paired to #$oldoppn $datap->[$oldoppn]{'name'}\n" 
        }
      $dirty{$dp->{name}}++;
      $pp->{'pairings'}[$round-1] = $oppn;
      }
    {
      printf "#%d %s (%.1f %+d) - #%d %s (%.1f %+d).\n",
        $datap->[$pns[0]]{id}, 
        $datap->[$pns[0]]{name}, 
	$datap->[$pns[0]]{wins},
	$datap->[$pns[0]]{spread},
        $datap->[$pns[1]]{id}, 
        $datap->[$pns[1]]{name}, 
	$datap->[$pns[1]]{wins},
	$datap->[$pns[1]]{spread},
	;
    }
    }
  UpdateDivisions \%dirty;

  0;
  }

sub CmdPartialSwiss ($$) { my($argvp, $args) = @_;
  print "WARNING: deprecated\n";
  shift @$argvp;
  my $usage = "Usage: Swiss repeats p1 p2 division-name\n";
  my $repeats = shift @$argvp;
  unless (defined $repeats && $repeats =~ /^\d+$/) { print $usage; return 0; }
  my $p1 = shift @$argvp;
  unless (defined $p1 && $p1 =~ /^\d+$/ && $p1 >= 1) { print $usage; return 0; }
  my $p2 = shift @$argvp;
  unless (defined $p2 && $p2 =~ /^\d+$/ && $p2 >= $p1) 
    { print $usage; return 0; }
  my $dp = (ParseDivisionName $argvp, $usage);
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};

  unless ($p2 <= $#$datap) { print $usage; return 0; }

  DoSwiss $dp, $repeats, $p1, $p2;
  0;
  }

# Swiss based on round n-3, not n-1
sub CmdPrePreSwiss ($$) { my($argvp, $args) = @_;
  print "WARNING: deprecated\n";
  shift @$argvp;
  my $usage = "Usage: PrePreSWiss repeats division-name\n";
  my $repeats = shift @$argvp;
  unless (defined $repeats && $repeats =~ /^\d+$/) { print $usage; return 0; }
  my $dp = (ParseDivisionName $argvp, $usage);
  return 0 unless defined $dp;

  DoSwiss $dp, $repeats, 1, $#{$dp->{'data'}}, 2;
  0;
  }

# Swiss based on round n-2, not n-1
sub CmdPreSwiss ($$) { my($argvp, $args) = @_;
  print "WARNING: deprecated\n";
  shift @$argvp;
  my $usage = "Usage: PRESWiss repeats division-name\n";
  my $repeats = shift @$argvp;
  unless (defined $repeats && $repeats =~ /^\d+$/) { print $usage; return 0; }
  my $dp = (ParseDivisionName $argvp, $usage);
  return 0 unless defined $dp;

  DoSwiss $dp, $repeats, 1, $#{$dp->{'data'}}, 1;
  0;
  }

sub CmdQuit ($$) {
  print "tsh quits.\n";
  1;
  }

sub CmdRandomScores ($$) { my($argvp, $args) = @_;
  shift @$argvp;
  my $usage = "Usage: RandomScores division-name...\n";
  do { {
    my $dp = (ParseDivisionName $argvp, $usage);
    next unless defined $dp;
    print "Adding random scores to division $dp->{'name'}.\n";
    for my $p (@{$dp->{'data'}}) {
      if (defined $p) {
        push(@{$p->{'scores'}}, int(200+$p->{'rating'}/20+rand(100)));
        printf "%s: @{$p->{'scores'}}\n", (TaggedName $p);
        }
      }
    SynchDivision $dp;
    WriteDivision $dp;
    } } while ($#$argvp>=0);
  0;
  }

sub CmdRatings ($$) { my($argvp, $args) = @_;
  my ($dp) = ParseArgs $argvp, [qw(division)];
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};

  # prepare CalculateRatings arguments - ugh
  my (@ps);
  for my $id1 (1..$#$datap) {
    my $id0 = $id1-1;
    my $pdp = $datap->[$id1];
    $ps[$id0] = {
      'ewins' => $pdp->{'ratedwins'},
      'name' => $pdp->{'name'},
      'oldr' => $pdp->{'rating'},
      'opps' => [ map { $_-1 } @{$pdp->{'pairings'}} ],
      'rgames' => $pdp->{'ratedgames'},
      'scores' => $pdp->{'scores'},
      'totalg' => 100,
      };
    }
  # TODO: support split ratings, specified on tsh.config
  for my $lib (qw(ratings ratings2)) {
    eval 'require "$lib.pl"';
    if ($@) {
      print "I can't find the $lib.pl library, so I can't do ratings.\n";
      return 0;
      }
    }
  &ratings2'CalculateRatings(\@ps, 'oldr', 1, 'newr', 10000, 'ewins');

  my $ms1 = $dp->{'maxs'}+1;
  open(RATINGS, ">$dp->{'name'}-ratings.doc") 
    or warn "can't create tee log: $!\n";
  log_ratings "Estimated Ratings";
  log_ratings " for Division $dp->{'name'}" if $gNDivisions > 1;
# log_ratings " after Round $dp->{'maxs'}"; # not working correctly
  log_ratings "\n\n";
  log_ratings "Rank  Won-Lost Spread OldR NewR Delta Player\n\n";

  my $lastw = -1; my $lasts = 0; my $rank = 0; my $i = 0;
  for my $p (sort by_current_standing @$datap[1..$#$datap]) {
    next if defined $p->{'etc'}{'off'};
    my $wins = $p->{'wins'};
    my $spread = $p->{'spread'};
    $i++;
    if ($wins != $lastw || $spread != $lasts) 
      { $lastw = $wins; $lasts = $spread; $rank = $i; }
    my $newr = $ps[$p->{'id'}-1]{'newr'};
    log_ratings sprintf("%4d %4.1f-%4.1f %+5d  %4d %4d %+5d %s\n",
      $rank, $wins,
      $#{$p->{'scores'}}+1-$wins, $spread,
      $p->{'rating'},
      $newr,
      $newr-$p->{'rating'},
      (TaggedName $p)
      ) unless $p->{name} =~ /^bye /;
    }
  close(RATINGS);
  0;
  }

# TODO: convert to using ParseArgs
sub CmdResultsByRound ($$) { my($argvp, $args) = @_;
  shift @$argvp;
  my $usage = "Usage: ResultsByRound r1[-r2] div\n";
  my $rounds = shift @$argvp;
  unless (defined $rounds) { print $usage; return 0; }
  my @rounds = split(/-/, $rounds, 2);
  $rounds[1] = $rounds[0] if $#rounds == 0;
  my $dp = (ParseDivisionName $argvp, $usage);
  unless (defined $dp && $#$argvp == -1) { print $usage; return 0; } 
  if ($rounds[0] == $rounds[1]) {
    print "Standings Based only on Results of Round $rounds[0]: Division $dp->{name}\n";
    }
  else {
    print "Standings Based only on Results of Rounds $rounds[0]-$rounds[1]: Division $dp->{name}\n";
    }
  print "\n";
  print "Wins Spread Rtng Player\n\n";
  
  $rounds[0]--;
  $rounds[1]--;
  my $datap = $dp->{data};
  for my $p (@$datap[1..$#$datap]) {
    $p->{twins} = $p->{tspread} = 0;
    my $pairingsp = $p->{pairings};
    for my $r ($rounds[0]..$rounds[1]) {
      my $opp = $pairingsp->[$r];
      my $oppscore = $opp ? $datap->[$opp]{'scores'}[$r] : 0;
      my $thisSpread = $p->{'scores'}[$r] - $oppscore;
      $p->{tspread} += $thisSpread;
      $p->{twins} += (1 + ($thisSpread <=> 0))/2;
      }
    }
  
  for my $p (sort { $b->{twins}<=>$a->{twins} || $b->{tspread}<=>$a->{tspread} } 
    @$datap[1..$#$datap]) {
    printf "%4.1d %+5d  %4d %s\n", $p->{twins}, $p->{tspread}, 
      $p->{rating}, (TaggedName $p) unless $p->{name} =~ /^bye /;
    }
  0;
  }
  
sub CmdRoundRobin ($$) { my ($argvp, $args) = @_;
  my ($dp) = ParseArgs $argvp, [qw(division)];
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};
  my $nplayers = $#$datap;

  # check that division is not partially paired
  {
    my $unpaired = GetUnpaired $dp, 'can be empty';
    my $nunpaired = $#$unpaired+1;
    if ($nunpaired > 0 && $nunpaired != $nplayers) {
      print "Can't add a round robin to a division whose last round is partially paired.\n";
      print "$nunpaired/$nplayers unpaired.\n";
      return 0;
      }
  }
# SpliceInactive @$unpaired, $nplayers-1;

  print "Calculating round robin pairings for Division $dp->{'name'}.\n";
  # add pairings information one round at a time
  my $schedule_size = $nplayers + ($nplayers % 2);
  for (my $oppi = $schedule_size; $oppi > 1; $oppi--) {
    DoClark %$dp, $oppi;
    }

  SynchDivision $dp;
  WriteDivision $dp;
  0;
  }
  
sub CmdRoundStandings ($$) { my($argvp, $args) = @_;
  my ($round, $dp)
    = ParseArgs $argvp, [qw(based-on-round division)];
  return 0 unless defined $dp;
  my $round0 = $round - 1;
  CheckRoundHasResults $round0, $dp or return 0;

  print "Round $round Standings: Division $dp->{'name'}.\n";
  print "\n";
  print "Rank  Won-Lost Spread Rtng Player\n\n";

  my $datap = $dp->{'data'};
  my $lastw = -1; my $lasts = 0; my $rank = 0; my $i = 0;
  my (@sorted) = SortByStanding $round0, GetAllPlayers $dp;
  for my $p (@sorted) {
    my $wins;
    my $losses;
    my $spread;

    next if defined $p->{'etc'}{'off'};
    if ($round0 < 0) { $wins = $losses = $spread = 0; }
    elsif (defined ($wins = $p->{'rwins'}[$round0])) {
      $losses = $round0 + 1 - $wins;
      $spread = $p->{'rspread'}[$round0];
      }
    else {
      $wins = $p->{'wins'};
      $losses = $#{$p->{'rwins'}} + 1 - $wins;
      $spread = $p->{'spread'};
      }
    $i++;
    if ($wins != $lastw || $spread != $lasts) {
      $lastw = $wins;
      $lasts = $spread;
      $rank = $i;
      }
    printf "%4d %4.1f-%4.1f %+5d  %4d %s\n", $rank, 
      $wins, $losses, $spread,
      $p->{'rating'}, (TaggedName $p) unless $p->{name} =~ /^bye /;
    }
  0;
  }

# TODO: fold opt_p into ParseArgs
sub CmdShowPairings ($$) { my($argvp, $args) = @_;
  my $opt_p = 0;
  if (@$argvp && $argvp->[0] eq '-p') {
    shift @$argvp;
    $opt_p = 1;
    }
  my ($round, $dp) = ParseArgs $argvp, [qw(round division)];
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};
  my $round0 = $round-1;

  CheckAutoPair $dp, $round;
  if ($round0 > $dp->{'maxp'} ) {
    print "No pairings yet for division $dp->{'name'} round $round.\n";
    return 0;
    }
  if ($opt_p) {
    print '[';
    print join(',', map {
      $_->{'pairings'}[$round0]-1 
      } @$datap[1..$#$datap]);
    print "]\n";
    return 0;
    }
  open(PAIRINGS, ">$dp->{'name'}-pairings.doc") 
    or warn "can't create tee log: $!\n";
  open(PAIRINGS_HTML, ">$dp->{'name'}-pairings.html") 
    or warn "can't create tee log: $!\n";
  &MacPerl'SetFileInfo('MSWD', 'TEXT', "$dp->{'name'} pairings") 
    if defined &MacPerl'SetFileInfo;
  {
    my $title = "Round $round Pairings";
    if ($gNDivisions > 1) { $title = "Division $dp->{'name'} $title"; }
    my ($text, $html) = ReportHeader $title;
    log_pairings $text, $html;
  }
  log_pairings '', <<'EOF';
<table class=pairings align=center>
<tr>
EOF
  # sample config line: perl $config'tables{'A'} = [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10];
  # (for 20 2-board tables)
  my $tables = $config'tables{$dp->{'name'}};
  # sample config line: perl $config'reserved{'P'}[13] = 4;
  # (to permanently station disabled player #13 in division P at board 4) 
  my $reserved = $config'reserved{$dp->{'name'}};
  if (defined $tables) {
    log_pairings 'Table ', '<th class=table>Table';
    my $shortage = length(sprintf($config'table_format, ''))-3;
    die "table format must be at least three characters wide\n"
      if $shortage < 0;
    log_pairings ((' ' x $shortage), '</th>');
    }
  log_pairings "Board Players\n", <<'EOF';
<th class=board>Board</th>
<th class=name>Who Plays Whom</th>
</tr>
EOF
  {
    my %done;
    my %reserved;
    my @unreserved;
    my @errors;
    
    my @sorted;
    {
      my $sr0 = $round - 2;
      $sr0 = 0 if $sr0 < 0;
      $sr0 = $dp->{maxs} if $sr0 > $dp->{maxs};
      @sorted = SortByStanding $sr0, GetAllPlayers $dp;
    }
    for my $p (@sorted) {
      next if defined $p->{'etc'}{'off'};
      my $opp = $p->{'pairings'}[$round0];
      if (!defined $opp) {
        log_pairings sprintf("  $config'table_format ", ''), 
	  '<td class=notable>&nbsp;</td>' if defined $tables;
        log_pairings sprintf("      %s: UNPAIRED.\n", (TaggedName $p)),
	  '<td class=unpaired>UNPAIRED</td><td class=name>' . 
	  (TaggedName $p) . '</td>';
        }
      elsif ($opp == 0) {
        log_pairings sprintf("  $config'table_format ", ''), 
	  '<td class=notable>&nbsp;</td>' if defined $tables;
        log_pairings sprintf("      %s: BYE.\n", (TaggedName $p)),
	  '<td class=bye>BYE</td><td class=name>' . 
	  (TaggedName $p) . '</td>';
        $done{$p->{id}} = 1;
        }
      elsif (!$done{$opp}) {
        if ($done{$p->{id}}++) {
	  push(@errors, "Can't list #$p->{id} $p->{name} as paired to #$opp $datap->[$opp]{name} because #$p->{id} already has an opponent.\n");
	  next;
	  }
	else { $done{$opp}++; }
        if (defined $reserved && defined $reserved->[$p])
          { $reserved{$reserved->[$p]} = [$p, $datap->[$opp]]; }
        elsif (defined $reserved && defined $reserved->[$opp])
          { $reserved{$reserved->[$opp]} = [$datap->[$opp], $p]; }
        else { push (@unreserved, [$p, $datap->[$opp]]); }
        }
      elsif (!$done{$p->{id}}) {
	push(@errors, "Can't list #$p->{id} $p->{name} as paired to #$opp $datap->[$opp]{name} because #$opp already has an opponent.\n");
        }
      } # for $p
    {
      my $board = 0;
      for my $b (@unreserved) {
        my ($p, $opp) = @$b;
        # skip until we find a vacant board
        while (defined $reserved{$board}) { $board++; }
	log_pairings '', '<tr>';
        log_pairings sprintf(" $config'table_format  ", $tables->[$board]),
	  "<td class=table>$tables->[$board]</td>"
	  if defined $tables;
	my $vs = FormatPairing $dp, $round0, $p->{id};
	unless ($vs) {
	  log_pairings "Lost track of $p->{name}", "Lost track of $p->{name}";
	  next;
	  }
	my $vshtml = $vs;
	$vshtml =~ s/\*(?:starts|draws)\*/<span class=starts>$&<\/span>/;
        log_pairings sprintf(" %3d  %s.\n", $board+1, $vs),
	  '<td class=board>' . ($board+1) . "</td><td class=name>$vshtml</td></tr>\n"
	  ;
        $board++;
        }
      for my $b (sort { $a <=> $b } keys %reserved) {
        my ($p, $opp) = @{$reserved{$b}};
        my $board = $reserved->[$p->{'id'}];
        die "Oops!" unless defined $board;
	log_pairings '', '<tr>';
        log_pairings sprintf(" $config'table_format  ", $tables->[$board]),
	  "<td class=table>$tables->[$board]</td>"
	  if defined $tables;
	my $vs = FormatPairing $dp, $round0, $p->{id};
        log_pairings sprintf(" %3d  %s.\n", $board+1, $vs),
	  '<td class=board>' . ($board+1) . "</td><td class=name>$vs</td></tr>";
	  ;
        }
    }
  print @errors;
  }
  log_pairings '', '</table>';
  {
    my ($text, $html) = ReportTrailer;
    log_pairings $text, $html;
  }
  close(PAIRINGS);
  close(PAIRINGS_HTML);
  0;
  }

sub CmdShowScoreCard ($$) { my($argvp, $args) = @_;
  my ($dp, $pn) = ParseArgs $argvp, [qw(division player-number)];
  return 0 unless defined $pn;
  my $datap = $dp->{'data'};
  my $p = $datap->[$pn];
  unless (defined $p) { print "No such player: $pn.\n"; return 0; }

  # print header
  print "Player Scorecard: ", (TaggedName $p), " ($p->{'rating'})";
  print " INACTIVE" if defined $p->{'etc'}{'off'};
  print "\n";
  print "Rnd ";
  print "1/2 " if $config'track_firsts;
  printf "Opp Rtng $config'name_format  Won-Lost For Agn Sprd CumSp\n",
    'Opponent name';

  # print one line for each paired or played round
  my $pairingsp = $p->{'pairings'};
  my $scoresp = $p->{'scores'};
  my $max = $#$pairingsp > $#$scoresp ? $#$pairingsp : $#$scoresp;
  my $cume = 0;
  my $games = 0;
  my $wins = 0;
  for my $i (0..$max) {
    my $oid = $pairingsp->[$i];
    my $opp = $datap->[$oid];
    my $score = $scoresp->[$i];
    printf "%3d ", $i+1;
    if ($config'track_firsts) {
      my $p12 = $p->{'etc'}{'p12'}[$i];
      print !defined $p12 
        ? '    ' : ' ' . ('- ',"$p12 ","$p12 ",'? ', '??')[$p12] . ' ';
      }
    if ($oid) {
      printf "%3d %4d $config'name_format", $opp->{'id'}, $opp->{'rating'}, $opp->{'name'};
      }
    else {
      printf "%3s %4s $config'name_format", '', 'bye', '';
      }
    if (defined $score) {
      $games++;
      my $oscore = $oid ? $opp->{'scores'}[$i] : 0;
      my $spread = $score - $oscore;
      $cume += $spread;
      $wins += (1+($spread <=> 0))/2;
      printf " %4.1f-%4.1f %3d %3d %+4d %+5d", $wins, $games-$wins, $score, $oscore, $spread, $cume;
      }
    print "\n";
    } # for $i
  0;
  }

# TODO: parse -f # and division... using ParseArgs
sub CmdShowWallChart ($$) { my($argvp, $args) = @_;
  shift @$argvp;
  my $usage = "Usage: showWallChart [-f #] [division...]\n";
  my $from = 1;
  if (@$argvp && $argvp->[0] eq '-f') {
    shift @$argvp;
    $from = shift @$argvp;
    }
  $from--;
  do { {
    my $dp = (ParseDivisionName $argvp, $usage);
    next unless defined $dp;

    open(WC, ">$dp->{'name'}-WC.doc") or die "Can't create WC log: $!\n";
    log_wc "Wall Chart: Division $dp->{'name'}.\n\n";
    log_wc sprintf("$config'name_format\n", 'Player');
# TODO: show full and correct header
    my $datap = $dp->{'data'};
    for my $p (@$datap[1..$#$datap]) {
      next unless defined $p;
      my $line1 = sprintf("$config'name_format ", $p->{'name'});
      my $line2 = sprintf("$config'name_format ", '');
      my $spread = 0;
      my $wins = 0;
      my $cols = 0;
      for my $j (0..$#{$p->{'scores'}}) {
        my $opp = $p->{'pairings'}[$j];
        my $oppScore = $opp ? $datap->[$opp]{'scores'}[$j] : 0;
        my $thisSpread = $p->{'scores'}[$j] - $oppScore;
        $spread += $thisSpread;
        $wins += (1 + ($thisSpread <=> 0))/2;
	if ($j >= $from) {
	  $line1 .= sprintf("%5.1f ", $wins);
	  $line2 .= sprintf("%+5d ", $spread);
	  }
        unless ((1+$cols-$from) % 12) {
	  if ($j >= $from) {
	    log_wc "$line1\n$line2\n";
	    $line1 = $line2 = sprintf("$config'name_format ", '');
	    }
          }
	$cols++;
        } # for $j
      if ($line1 =~ /\S/) {
	log_wc "$line1\n$line2\n";
        }
      } # for my $p
    close(WC);
    } } while ($#$argvp >= 0);
  }

sub CmdStandings ($$) { my($argvp, $args) = @_;
  my ($dp) = ParseArgs $argvp, [qw(division)];
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};

  open(STANDINGS, ">$dp->{'name'}-standings.doc") 
    or warn "can't create tee log: $!\n";
  open(STANDINGS_HTML, ">$dp->{'name'}-standings.html") 
    or warn "can't create tee log: $!\n";

# TODO: should report round number?
  {
    my $round = $dp->{'maxs'} + 1;
    my $title = "Round $round Standings";
    if ($gNDivisions > 1) { $title = "Division $dp->{'name'} $title"; }
    my ($text, $html) = ReportHeader $title;
    log_standings $text, $html;
  }
  log_standings "Rank  Won-Lost  Spread Rtng Name\n\n", <<'EOF';
<table class=standings align=center>
<tr>
<th class=rank>Rank</th>
<th class=wl>Won-Lost</th>
<th class=spread>Spread</th>
<th class=rating>Rating</th>
<th class=name>Name</th>
</tr>
EOF

  my $lastw = -1; my $lasts = 0; my $rank = 0; my $i = 0;
  for my $p (sort by_current_standing @$datap[1..$#$datap]) {
    next if defined $p->{'etc'}{'off'};
    my $wins = $p->{'wins'};
    my $spread = $p->{'spread'};
    $i++;
    if ($wins != $lastw || $spread != $lasts) {
      $lastw = $wins;
      $lasts = $spread;
      $rank = $i;
      }
    unless ($p->{name} =~ /^bye /) {
      my (@fields) = ($rank, $wins, $#{$p->{'scores'}}+1-$wins, 
	  $spread, $p->{'rating'}, (TaggedName $p));
      log_standings 
        sprintf("%4d %4.1f-%4.1f %+5d  %4d %s\n", @fields),
	sprintf(<<'EOF', @fields);
<tr>
<td class=rank>%d</td>
<td class=wl>%4.1f-%4.1f</td>
<td class=spread>%+d</td>
<td class=rating>%d</td>
<td class=name>%s</td>
</tr>
EOF
      }
    }
  log_standings '', "</table>";
  {
    my ($text, $html) = ReportTrailer;
    log_standings $text, $html;
  }
  close(STANDINGS);
  close(STANDINGS_HTML);
  0;
  }

sub CmdSwiss ($$) { my($argvp, $args) = @_;
  print "WARNING: deprecated\n";
  shift @$argvp;
  my $usage = "Usage: Swiss repeats sr division-name\n";
  my $repeats = shift @$argvp;
  unless (defined $repeats && $repeats =~ /^\d+$/) { print "1. $usage"; return 0; }
  my $sr = shift @$argvp;
  unless ($sr =~ /^\d+$/) { print "2. $usage"; return 0; }
  my $dp = (ParseDivisionName $argvp, $usage);
  return 0 unless defined $dp;
  my $datap = $dp->{'data'};
  my $pre = $dp->{maxp} - ($sr+1);

  DoSwiss $dp, $repeats, 1, $#{$dp->{'data'}}, $pre;
  0;
  }

# TODO: should delete byes
sub CmdUnpairRound ($$) { my($argvp, $args) = @_;
  my ($round, $dp) = ParseArgs $argvp, [qw(based-on-round division)];
  return 0 unless defined $dp;
  my $round0 = $round - 1;

  if ($dp->{'maxp'} == -1) {
    print "There aren't any pairings in that division yet.\n";
    return 0;
    }

  if ($round0 != $dp->{'maxp'}) {
    printf "The only round you can unpair is the last paired one: %d\n",
      $dp->{'maxp'}+1;
    return 0;
    }
  
  if ($round0 <= $dp->{'maxs'}) {
    print "You can't unpair round $round, because it already has scores.\n";
    print "($dp->{'maxs_player'} is one player who has a score.)\n";
    print "Try using the DeleteScore command or editing the .t file.\n";
    return 0;
    }

  print "Deleting pairings for Division $dp->{'name'}, round $round.\n";
  my $datap = $dp->{'data'};
  for my $i (1..$#$datap) {
    my $p = $datap->[$i];
    my $pairingsp = $p->{'pairings'};
    if ($#$pairingsp == $round0) {
      my $opp = pop @$pairingsp;
      print "... $p->{id} unpaired from $opp.\n";
      }
    }
  SynchDivision $dp;
  WriteDivision $dp;
  print "Done.\n";

  0;
  }

# Count how many byes each player in a division has, save as $p->{'byes'}.
# Return the smallest number of byes.
sub CountByes ($) {
  my $dp = shift;

  my $datap = $dp->{'data'};
  my $minbyes = 9999999;

  for my $p (@$datap[1..$#$datap]) {
    next unless defined $p;
    my $byes = 0;
    for my $opp (@{$p->{'pairings'}}) {
      if ((defined $opp) && $opp == 0) {
	$byes++;
        }
      }
    $minbyes = $byes if $byes < $minbyes;
    $p->{'byes'} = $byes;
    }
  return $minbyes;
  }

sub DefineExternal ($$$) {
  my $name = lc shift;
  my $script = shift;
  my $template = shift;

  $config'externals{$name} = { 
    'args' => $template,
    'file' => "$global'path/$script",
    };
  $global'commands{$name} = \&CmdExternal;
  print " $name";
  return 1;
  }

# Add one round of Clark pairings to a division.  Clark pairings are
# described in the NSA Directors' Manual, and are a way of generating
# not especially high-quality round robin pairings.  This subroutine
# takes two arguments: a division reference and the opponent number for
# player #1.  Enumerating all the possible opponents for player #1 will
# result in a complete round robin schedule.

# TODO: improve the quality of the pairings, by rearranging the order
# in which players sit in their Clark circle so that when #1 plays #2,
# KOTH pairings result.

sub DoClark (\%$) {
  my $dp = shift;
  my $opp1 = shift;
  my $datap = $dp->{'data'};
  my $round = $dp->{'maxp'} + 1;
  my $n = $#$datap;
  my $odd = $n % 2;
  if ($odd) { # if division is odd, pair as per n+1 and fix up as we go
    $n++;
    $opp1 = $n if $opp1 == 0; # allow user to specify 
    }
  $datap->[1]{'pairings'}[$round] = 
    ($odd && $opp1 == $n) ? 0 : $opp1;
  $datap->[$opp1]{'pairings'}[$round] = 1 unless $odd && $opp1 == $n;
  for my $id (2..$n - $odd) {
    next if $id == $opp1;
    my $oppid = (2*$opp1 - $id + $n - 1) % ($n - 1);
    $oppid += $n-1 if $oppid <= 1;
#   print "id=$id oppid=$oppid opp1=$opp1 n=$n\n";
    die "Assertion failed (id=$id opp1=$opp1 n=$n oppid=$oppid)" 
      unless $oppid > 1 && $id != $oppid && $oppid <= $n;
    $oppid = 0 if $odd && $oppid == $n;
    $datap->[$id]{'pairings'}[$round] = $oppid;
    }
  SynchDivision $dp;
  }

sub DoNewSwiss ($$$) { my ($dp, $repeats, $sr0) = @_;
  my $datap = $dp->{'data'};
  my $theKeyRound = $sr0;

  my $tobepaired = (GetRegularUnpaired $dp, $sr0);
  printf "Players to be paired: %d\n", $#$tobepaired+1;
  return unless @$tobepaired;
  die "Assertion failed" unless @$tobepaired % 2 == 0;
  my (@ranked) = SortByStanding $theKeyRound, @$tobepaired;

# for my $p (@ranked) { print "$p->{'id'} $p->{'name'}\n"; }
  # divide into win groups
  my @win_groups = ();
  {
    my $wins = -1;
    for my $p (@ranked) {
      my $this_wins = $p->{'rwins'}[$theKeyRound];
      $this_wins = 0 unless defined $this_wins;
      if ($this_wins == $wins) {
        push(@{$win_groups[-1]}, $p);
        }
      else {
        push(@win_groups, [$p]);
        $wins = $this_wins;
        }
      } # for my $p
  } # divide into win groups
  # count repeats - this should be a sub, as it's duplicated in ResolvePairings
  for my $p (@ranked) {
    my (@repeats) = (0) x ($#$datap + 1);
    for my $j (0..$#$datap) { $repeats[$j] =0; }
    for my $j (@{$p->{'pairings'}}) { $repeats[$j]++; }
    $p->{'repeats'} = \@repeats;
#    print "$p->{'name'} [$p->{'id'}] repeats: ", join(' ', @repeats), "\n";
    }
  my @pair_list = Recursive_Swiss \@win_groups, 
    $repeats;
  unless (@pair_list) {
    print "Swiss pairings failed, try increasing repeats or using manual pairings.\n";
    return;
    }
  # store pairings
  {
    while (@pair_list) {
      my $p1 = shift @pair_list;
      my $p2 = shift @pair_list;
      push(@{$p1->{'pairings'}}, $p2->{'id'});
      push(@{$p2->{'pairings'}}, $p1->{'id'});
      }
  } # store pairings
  print "Done.\n";
  SynchDivision $dp;
  WriteDivision $dp;
  }

sub DoSwiss ($$$$;$) { my($dp, $repeats, $p1, $p2, $pre) = @_;
  $pre = 0 unless defined $pre;
  my $datap = $dp->{'data'};
  my $theKeyRound = $dp->{maxp} - $pre;

  print("Calculating Swiss pairings for division $dp->{'name'},"
    ." $repeats repeats, players $p1-$p2.\n");
  printf "... using round %d results.\n", $theKeyRound + 1;

  my $tobepaired = (GetUnpaired $dp);
print "tobepaired size: $#$tobepaired.\n";
  @$tobepaired = grep($_->{'id'} >= $p1 && $_->{'id'} <= $p2, @$tobepaired);
  if ($#$tobepaired % 2 == 0) {
    print "Can't Swiss pair an odd number of players.\n";
    return 0;
    }

print "tobepaired size: $#$tobepaired.\n";
  my ($maxpair, @offsets, $p, @pairing, $wins);

  # generate list of player offsets (see below)
  @offsets = (0); 
  for my $j (1..$#$tobepaired-1) { push(@offsets, $j, -$j); } 

  # sort by wins and spread, arrange tied players randomly
  my (@ranked) = SortByStanding $theKeyRound, @$tobepaired;

# for my $p (@ranked) { print "$p->{'id'} $p->{'name'}\n"; }

  # calculate pairings for each win group
# print "# calculating pairing preference lists\n";
  { my $n; for (my $i=0; $i<=$#ranked; $i += $n+$n) {
    my $message;

    # this group starts at position $i, how far does it go?
    $wins = $ranked[$i]{'rwins'}[$theKeyRound];
print "$ranked[$i]{'name'} has $wins wins in round $theKeyRound+1.\n";
    if ((!$config'noboys) && $i == 0 && defined $wins) {
      # Dave Boys' idea: first group includes anyone with at least 2/3 leader's wins
#      my $quota = 2*$wins/3;
      # 1.500: changed to 2/3 of total wins
      my $quota = 2*($theKeyRound+1)/3;
      $message = "# at least $quota wins: ";
      $n = 1;
      while ($n%2==1 || (
        $i+$n <= $#ranked && 
        $ranked[$i+$n]{'rwins'}[$theKeyRound] >= $quota
        ))
        { $n++; }
      }
    else {
      $message = "# $wins wins: ";
      $n = 1; # start n at 1 and increment until 
      while ($i+$n<=$#ranked && ( # we hit the end or...
        ((!defined $wins) && (!defined $ranked[$i+$n]{'rwins'}[$theKeyRound])) # number of wins becomes defined or...
        || $ranked[$i+$n]{'rwins'}[$theKeyRound] == $wins || $n%2)) # number of wins changes and n is even
        { $n++; }
      }
    $wins = 0 unless defined $wins;
    print "$message$i to $i+$n\n";
    $n >>= 1;

    # $j indexes how far we are along in the "semigroup"
    for (my $j=0; $j<$n; $j++) {
      # list pairings preferences for player $j in upper semigroup
# TODO: should prefer players in current group first
      { # scoping only
      my $me = $ranked[$i+$j];
      my @pairing = ();
# print "pairings for $me->{'name'} ($me->{'id'})\n";
      for my $k (@offsets) {
        next if $k == -$n; # identity check
        my $opprank = $i+$j+$k+$n;
        next if $opprank < 0 || $opprank > $#ranked; # range check
        my $oppid = $ranked[$opprank]->{'id'};
# print "  $ranked[$opprank]->{'name'} ($ranked[$opprank]->{'id'})\n";
        next if $me->{'repeats'}[$oppid] > $repeats; # re-pairing check
# print "  (ok)\n";
        push(@pairing, $ranked[$opprank]);
        }
      die "$me->{'name'} can't be paired!\n" unless $#pairing >= 0;
      $me->{'pref'} = \@pairing;
# print "$me->{'name'} ($me->{'id'}): @pairing\n";
      } # scoping

      { # scoping only
      # list pairings preferences for player $j in lower semigroup
      my $me = $ranked[$i+$j+$n];
      my @pairing = ();
# print "pairings for $me->{'name'}\n";
      for my $k (@offsets) {
        next if $k == $n; # identity check
        my $opprank = $i+$j+$k;
        next if $opprank < 0 || $opprank > $#ranked; # range check
        my $oppid = $ranked[$opprank]->{'id'};
# print "  $ranked[$opprank]->{'name'}\n";
        next if $me->{'repeats'}[$oppid] > $repeats; # re-pairing check
# print "  (ok)\n";
        push(@pairing, $ranked[$opprank]);
        }
# print "$me->{'name'} ($me->{'id'}): @pairing\n";
      die "$me->{'name'} can't be paired!\n" unless $#pairing >= 0;
      $me->{'pref'} = \@pairing;
      } # scoping
      } # for $j
    } } # for $i

# special check for bye player
byes:
  for my $i (0..$#ranked) {
    my($p) = $ranked[$i];
    if ($p->{'name'} =~ /^bye /i) {
      for my $j (0..$#ranked) {
        if ($i == $j) {
          my($k, @newpref, $repeatp);
          $repeatp = $p->{'repeats'};
          for ($k=$#ranked; $k>=0; $k--) { # bye pairs against bottom of field
            next if $k == $i; # bye doesn't pair against bye
            my $oppid = $ranked[$k]{'id'};
            next if $repeatp->[$oppid] > 0; # bye never repeats
            push(@newpref, $ranked[$k]);
            }
          $ranked[$j]{'pref'} = \@newpref;
          }
        }
      unshift(@ranked, splice(@ranked, $i, 1));
      last byes;
      } # if player is bye
    } # for $i (bye player)

  if (ResolvePairings $dp, \@ranked) {
    SynchDivision $dp;
    WriteDivision $dp;
    }
  }

# Return a formatted string describing one pairing
sub FormatPairing ($$$;$) {
  my $dp = shift;
  my $round0 = shift;
  my $pn1 = shift;
  my $style = shift || 'normal';
  my $datap = $dp->{'data'};

  my $pn2 = $datap->[$pn1]{'pairings'}[$round0]
    or return '';
  my $p = $datap->[$pn1];
  my $opp = $datap->[$pn2];
  my $p121 = $p->{'etc'}{'p12'}[$round0] || 0;
  my $p122 = $opp->{'etc'}{'p12'}[$round0] || 0;
  if ($p121 == 2 && $p122 == 1) { 
    if ($style eq 'half') { return 'second vs. ' . (TaggedName $opp); }
    ($p, $opp) = ($opp, $p);
    }
  elsif ($p121 == 3 && $p122 == 3) {
    if ($style eq 'half') { return 'draws vs. ' . (TaggedName $opp); }
    else { return (TaggedName $p) . ' *draws* vs. ' . (TaggedName $opp); }
    }
  elsif (!($p121 == 1 && $p122 == 2)) {
    if ($style eq 'half') { return 'vs. ' . (TaggedName $opp); }
    else { return (TaggedName $p) . ' vs. ' . (TaggedName $opp); }
    }
  if ($style eq 'half') { return 'first vs. ' . (TaggedName $opp); }
  else { return (TaggedName $p) . ' *starts* vs. ' . (TaggedName $opp); }
  }

# Return a vector of all players in a division
sub GetAllPlayers ($) {
  my $dp = shift;
  my $datap = $dp->{'data'};
  return @$datap[1..$#$datap];
  }

# Return a vector of players that need to be paired in the given division.
# Make adjustments if necessary, such as assigning a bye to make the
# vector even, or (still to do) Gibsonizing a clincher. Inactive players
# will be assigned their bye score.
sub GetRegularUnpaired ($$) {
  my $dp = shift;
  my $sr0 = shift; # used in assigning byes
  my $datap = $dp->{'data'};

  my $round0 = $dp->{'maxp'};
  $round0 = 0 if $round0 < 0;
  my $psp = GetUnpaired $dp, 'empty is ok';
  # if last round paired is complete
  if (!@$psp) {
    # use next round
    $round0++; 
    $psp = [@$datap];
    shift @$psp;
    SpliceInactive @$psp;
    }

  # check to see if we need a bye
  if (@$psp % 2) {
    my $minbyes = CountByes $dp;
    my $p = (SortByStanding $sr0, grep { $_->{'byes'} == $minbyes } @$psp)[-1]
      or die "Tried to choose a bye but couldn't find any players?!";
    # only assign the by pairing, don't register the +50, as some routines
    # (and operators) may get confused by having early score data present
    $p->{'pairings'}[$round0] = 0;
    my $found = 0;
    # TODO: test to see how slow this is, fix if necessary
    for my $i (0..$#$psp) {
      if ($psp->[$i] eq $p) {
	$found = 1;
	splice(@$psp, $i, 1);
	last;
        }
      }
    print "Gave a bye to $p->{'name'}.\n";
    # We have to call SynchDivision to update maxp
    SynchDivision $dp;
    # and we do have to call WriteDivision because later parsing might fail
    WriteDivision $dp;
    }

  return $psp;
  }

# return a vector of players that need to be paired
sub GetUnpaired ($;$) {
  my $dp = shift;
  my $emptyok = shift;

  my $datap = $dp->{'data'};
  my @unpaired = @{GetUnpairedRound $dp, $dp->{'maxp'}};

  # if we didn't find any in the last round, return complete vector
  if ($#unpaired < 0 && !$emptyok) { 
    @unpaired = @$datap;
    shift @unpaired;
    SpliceInactive @unpaired;
    }
  
  return \@unpaired;
  } # sub GetUnpaired

# return a vector of players that need to be paired
sub GetUnpairedRound ($$) {
  my $dp = shift;
  my $round0 = shift;

  my $datap = $dp->{'data'};
  my @unpaired = ();

  # first check for an already partially paired round
  for my $p (@$datap[1..$#$datap]) {
    next unless $p && !defined $p->{'pairings'}[$round0];
    push(@unpaired, $p);
    } # for $p

  SpliceInactive @unpaired;
  
  return \@unpaired;
  } # sub GetUnpairedRound

sub lint () {
  %config'externals = ();
  $config'noboys = 0;
  $config'reserved{''} = '';
  $config'tables{''} = '';
  lint;
  }

sub log_ratings ($) { print $_[0]; print RATINGS $_[0]; }
sub log_pairings ($$) { 
  print $_[0];
  print PAIRINGS $_[0]; 
  print PAIRINGS_HTML $_[1];
  }
sub log_standings ($$) {
  print $_[0];
  print STANDINGS $_[0];
  print STANDINGS_HTML $_[1];
  }
sub log_wc ($) { print WC $_[0]; print $_[0]; }

sub Main () {
  srand;

# {
#   my $dawg = 'gloria:john:19990925-toronto:twl98.dawg';
#   $dawg = "$ENV{'HOME'}/scrabble/ospd/words.dawg" 
#     unless -f $dawg;
#   &dawg'open(*TWL98, $dawg) || warn "Can't open TWL98 file.\n";;
# }

  mkdir $config'backup_directory, 0700 unless -d $config'backup_directory;

  ReopenConsole if $^O eq 'MacOS';
  print "\nWelcome to tsh version $gkVersion.\n";
  ReadConfig;
  ReadDivisions;
  Prompt;
  while (<>) {
    next unless /\S/;
    my(@argv) = split;
    my $sub = $global'commands{lc $argv[0]};
    if (defined $sub) { last if &$sub(\@argv, $_); }
    else { print "Enter 'help' for help.\n"; }
    }
  continue {
    Prompt;
    }
  }

BEGIN {
  %global'ParseArgsDispatch = (
    'based-on-round' => \&ParseBasedOnRoundNumber,
    'division' => \&ParseDivisionName,
    'nothing' => \&ParseNothing,
    'nrounds' => \&ParseNRounds,
    'player-number-or-0' => \&ParsePlayerNumberOrZero,
    'player-number' => \&ParsePlayerNumber,
    'repeats' => \&ParseRepeats,
    'round' => \&ParseRoundNumber,
    'score' => \&ParseScore,
    );
  }

sub ParseArgs ($$) {
  my $argvp = shift;
  my $typesp = shift;

  my $arg0 = shift @$argvp;
  my $usage = "Usage: $arg0 ";
  if ($gNDivisions == 1) {
    $usage .= join(' ', grep { $_ ne 'division' } @$typesp);
    }
  else {
    $usage .= join(' ', @$typesp);
    }
  $usage .= "\n";

  my @values;
  $global'parse_error = '';
  for my $type (@$typesp, 'nothing') {
    my $sub = $global'ParseArgsDispatch{$type};
    die "Unknown argument type ($type)." unless $sub;
    my $value = &$sub($argvp, $usage);
    if (defined $value) { push(@values, $value); }
    else { $global'parse_error ||= 'error'; return (); }
    }
  return @values;
  }

sub ParseBasedOnRoundNumber ($$) { my ($argvp, $usage) = @_;
  return ParseInteger $argvp, $usage, 'round number', 0, 10000;
  }

sub ParseDivisionName ($$) {
  my $argvp = shift;
  my $usage = shift;

  if ($gNDivisions == 1) { 
    if (defined $gDivision{lc $argvp->[0]}) {
      shift @$argvp;
      }
    return (%gDivision)[1]; 
    }
  elsif ($#$argvp < 0) { 
    print "You must specify a division name with this command.\n";
    print $usage; 
    return undef; 
    }
  else {
    my $dn = lc shift @$argvp;
    my $dp = $gDivision{$dn};
    if (!defined $dp) { 
      print "No such division: \U$dn\E.\n"; 
      print $usage;
      return undef; 
      }
    else { 
      return $dp;
      }
    }
  }
     
sub ParseInteger ($$$$$) {
  my $argvp = shift;
  my $usage = shift;
  my $typename = shift;
  my $min = shift;
  my $max = shift;

  if ($#$argvp < 0) { 
    print "Please specify a $typename.\n";
    print $usage; 
    return undef; 
    }
  my $n = shift @$argvp;
  if ($n !~ /^-?\d+$/) {
    print "This doesn't look like a $typename to me: $n.\n";
    print $usage;
    return undef;
    }
  if ($n < $min) {
    print "$n is too small to be a $typename.\n";
    print $usage;
    return undef;
    }
  if ($n > $max) {
    print "$n is too big to be a $typename.\n";
    print $usage;
    return undef;
    }
  return $n;
  }

sub ParseNothing ($$) {
  my $argvp = shift;
  my $usage = shift;

  if (@$argvp) {
    print "I don't understand this bit at the end: @$argvp\n";
    print $usage;
    return undef;
    }
  return 1;
  }

sub ParseNRounds ($$) { my ($argvp, $usage) = @_;
  return ParseInteger $argvp, $usage, 'number of rounds', 1, 10000;
  }

sub ParsePlayerNumber ($$) { my ($argvp, $usage) = @_;
  return ParseInteger $argvp, $usage, 'player number', 1, 100000;
  }

sub ParsePlayerNumberOrZero ($$) { my ($argvp, $usage) = @_;
  return ParseInteger $argvp, $usage, 'player number', 0, 100000;
  }

sub ParseRepeats ($$) { my ($argvp, $usage) = @_;
  return ParseInteger $argvp, $usage, 'number of repeat pairings per player',
    0, 1000;
  }

sub ParseRoundNumber ($$) { my ($argvp, $usage) = @_;
  return ParseInteger $argvp, $usage, 'round number', 1, 10000;
  }

sub ParseScore ($$) { my ($argvp, $usage) = @_;
  return ParseInteger $argvp, $usage, 'score', -500, 1500;
  }

sub Prompt () { print $gPrompt[-1]; }

sub ReadConfig () {
  $config'table_format = '%3s';
  open(CONFIG, "<tsh.config") || die "Can't open tsh.config: $!\n";
  local($_);
  print "Loading configuration file.\n";
  $gNDivisions = 0;
  while (<CONFIG>) { s/#.*//; s/^\s*//; s/\s*$//; next unless /\S/;
    if (/^division?\s+(\S+)\s+(.*)/i) {
      $gDivision{lc $1} = 
        bless {'file' => $2, 'name' => (uc $1)}, 'TSH::Division';
      $gNDivisions++;
      }
    elsif (s/^perl\s+//i) { 
      eval $_;
      print "eval: $@\n" if length($@);
      }
    elsif (s/^config\s+//i) { 
      eval q($config') . $_;
      print "eval: $@\n" if length($@);
      }
    elsif (s/^autopair\s+//i) { 
      if (/^(\w+) (\d+) (\d+)\s+(\w+)\s+(.*)/) {
	my ($div, $sr, $round, $command, $args) = ($1, $2, $3, $4, $5);
	my (@args) = split(/\s+/, $args);
	if ($command =~ /^(?:if|koth|ns|newswiss|rr|roundrobin)$/i) {
	  $config'autopair{uc $div}[$round] = [$sr, $command, @args];
	  }
	else {
	  die "Unsupported autopair pairing system: $command\n";
	  }
        }
      else {
	chomp;
	die "Can't parse 'autopair $_' in tsh.config\n";
        }
      }
    else {
      print "Can't parse: $_\n";
      }
    }
  print "Configuration file loaded.\n";
  if (@config'external_path) {
    print "Loading external(s)";
    for $global'path (@config'external_path) {
      my $config = "$global'path/tshxcfg.txt";
      if (-r "$config") {
	my $rv = do $config;
	if ($@) { print " [\@$@]"; }
	if ($!) { print " [!$!]"; }
	unless ($rv) { print " [X]"; }
        }
      }
    print "\n";
    }
  }

sub ReadDivision (\%) {
  my $dp = shift;
  my $fn = $dp->{'file'};
  print "Loading division $dp->{'name'}.\n";
  open(DIV, "<$fn") || die "Can't open $fn: $!\n";
  local($_);
  my (@data) = (undef);
  my $id = 1;
  my $name_length = 16;
  while (<DIV>) { s/#.*//; s/^\s*//; s/\s*$//; next unless /\S/;
# TODO: find longest player name
    my($player, $rating, $pairings, $scores, $etc) 
      = /^([^;]+[^;\s\d])\s+(\d+)\s*([\d\s]*);\s*([-\d\s]*)((?:;[^;]*)*)$/;
    die "Can't parse: $_\n" unless defined $scores;
    $name_length = length($player) if $name_length < length($player);
    my(@pairings) = split(/\s+/, $pairings);
    my(@scores) = split(/\s+/, $scores);
    my $pp = { 
      'division' => $dp,
      'id'       => $id,
      'name'     => $player,
      'rating'   => $rating,
#     'rnd'=>rand,
      'rnd'      => ((length($player) * (100+$id) * ord($player)) % 641),
      'pairings' => [split(/\s+/, $pairings)],
      'scores'   => [split(/\s+/, $scores)],
      };
    for my $extra (split(/;\s*/, $etc)) {
      next unless $extra =~ /\S/;
      my ($tag, @words) = split(/\s+/, $extra);
      if (defined $pp->{$tag}) {
	warn "Overwriting $tag field for $player.\n";
        }
      $pp->{'etc'}{$tag} = \@words;
      }
    push(@data, $pp);
    $id++;
    }
  close(DIV);
  if ($name_length > $config'max_name_length) {
    $config'max_name_length = $name_length;
    $config'name_format = "%-${name_length}s";
    }

  print "Warning: odd number of players in Division $dp->{'name'}.\n"
    if $#data % 2 == 1;
  $dp->{'data'} = \@data;
  SynchDivision $dp;
  }

sub ReadDivisions () {
  for my $dp (values %gDivision) {
    ReadDivision %$dp;
    } 
  print "All divisions loaded.\n";
  }

# Recursive_Swiss: recursively perform swiss pairings
#
# capsule summary of algorithm
#
# if we have one group, try all pairings until we find one that works
# or have exhausted all possibilities.  preference order for opponents
# is based on distance from ideal Swiss opponent (1 plays ceil(n/2))
#
# if we have more than one group, first make it even by promoting a
# player if necessary.  then try pairing it, and if we fail, keep 
# promoting two players at a time until we succeed or run out of
# players and fail

sub Recursive_Swiss ($$) {
  # [[p1,p2],[p3],[p4,p5,p6],...] divided into pairings groups
  # number of players must be even (assign bye before calling)
  my $win_groupsp = shift; # passed as reference, but shouldn't be modified
  # 0 indicates no repeats allowed, ..., 3 means up to 3 repeats = 4 pairings
  my $repeats = shift;

#  print "RS([",join(',',map { '[' . join(',', @$_) . ']' } @$win_groupsp), "])\n"; # swiss-debug
  confess "no groups\n" unless @$win_groupsp;

  # if we're down to one group, try all possibilities
  if ($#$win_groupsp == 0) {
    my $win_groupp = $win_groupsp->[0];
    my $group_size = $#$win_groupp + 1;
    # odd number of players - oops
    if ($group_size % 2) {
      die "Odd number of players in last win group:" 
        . join(',', map { $_->{'id'}} @$win_groupp)
	. "\nAborting";
      }
    # no more players - shouldn't happen
    elsif ($group_size == 0) {
      die "Ran out of players?!\n";
      }
    # one pair left - almost as easy
    elsif ($group_size == 2) {
      my ($p1, $p2) = @$win_groupp;
      if ($p1->{'repeats'}[$p2->{'id'}] <= $repeats) {
#        print "RS=($p1->{'id'},$p2->{'id'}) rpt=$p1->{'repeats'}[$p2->{'id'}]\n"; # swiss-debug
        return ($p1, $p2);
	}
      else {
#        print "RS failed\n"; # swiss-debug
        return ();
	}
      }
    # more than one pair - try each possible opp for first player, recurse
    else {
      my ($p1, @opps) = @$win_groupp;
      # prefered opponent is halfway down the group
      my $index = $#opps/2;
      # after $index, we try $index + 1, $index - 2, $index + 3, ...
      my $delta = 1;
      my $sign = 1;
      for my $i (0..$#opps) {
        my $p2 = $opps[$index];
	if ($p1->{'repeats'}[$p2->{'id'}] <= $repeats) {
# print qq(RS:PC{$p1 $p2}=$p1->{'repeats'}[$p2->{'id'}]<=$repeats\n) if $p1 == 4 || $p2 == 4;
	  my (@group) = @opps;
	  splice(@group, $index, 1);
	  my (@paired) = Recursive_Swiss [\@group], $repeats;
	  if (@paired) { # success! :)
# 	    print "RS=(", join(',', $p1, $p2, @paired), ")\n"; # swiss-debug
	    return ($p1, $p2, @paired);
	    }
	  }
	}
      continue {
	$index += $delta;
	$delta = -($delta + $sign);
	$sign = -$sign;
	}
      # failure! :(
#     print "RS failed (2)\n"; # swiss-debug
      return ();
      }
    }
  # else we have more than one group
  else {
    # make sure we have an even number of players
    my ($carp, @cdr) = @$win_groupsp;
    my (@car) = (@$carp); # copy so as not to change master copy
    my @cadr;
    unless ($#$carp % 2) {
      # [1] get (copy, so we don't mess things up) the next group
      (@cadr) = (@{shift @cdr});
      # move its top player to top group
      push(@car, shift @cadr);
      # if that didn't empty the next group, put it back
      if (@cadr) { unshift(@cdr, \@cadr); }
      }
    # pair within the group, then keep promoting pairs
    while (1) {
      my (@car_paired) = Recursive_Swiss [\@car], $repeats;
      if (@car_paired) {
        if (@cdr) { # still some unpromoted
	  my (@cdr_paired) = Recursive_Swiss \@cdr, $repeats;
	  if (@cdr_paired) { # all done!
#	    print "RS=(", join(',', @car_paired, @cdr_paired), ")\n"; # swiss-debug
	    return(@car_paired, @cdr_paired);
	    }
	  }
	# everybody got promoted
	else {
	  return (@car_paired);
	  }
	}
      # did we run out of players?
      last unless @cdr;
      # promote one, see [1] for comments
      (@cadr) = (@{shift @cdr}); 
      push(@car, shift @cadr);
      if (@cadr) { unshift(@cdr, \@cadr); }
      die "Ark error - did you forget to assign a bye?\n" unless @cdr;
      # promote the other, see [1] for comments
      (@cadr) = (@{shift @cdr}); 
      push(@car, shift @cadr);
      if (@cadr) { unshift(@cdr, \@cadr); }
      }
    # ran out of players - d'oh!
#   print "RS failed (3)\n"; # swiss-debug
    return ();
    }
  }

sub ReopenConsole () {
  close(STDOUT);
  close(STDERR);
  close(STDIN);
  open(STDOUT, "+>dev:console:tsh console") || die;
  open(STDERR, "+>dev:console:tsh console") || die;
  open(STDIN, "<dev:console:tsh console") || die;
  $| = 1;
  }

sub ReportHeader ($) {
  my $title = shift;
  my $html = '';
  $html .= <<"EOF";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
	"http://www.w3.org/TR/REC-html40/loose.dtd">
<html><head><title>$title</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<link rel="stylesheet" href="tsh.css" type="text/css">
</head>
<body>
EOF
  $html .= $config'html_top if $config'html_top;
  $html .= "<h1>$title</h1>\n";
  return ("$title\n\n", $html);
  }

sub ReportTrailer () {
  return ('', "<p class=notice>This report was generated using <cite>tsh</cite> version $gkVersion.  For more information about <cite>tsh</cite>, please ask John Chew.</p></body></html>");
  }

# Given a division and a list of unpaired players who have their
# 'pref' field set to a list of opponent preferences, find a reasonable
# pairing of all the players
sub ResolvePairings ($$) {
  my ($dp, $unpairedp) = @_;

# { my $p; for $p (@$unpairedp) { print "# $p->{'name'}: @{$p->{'pref'}}\n"; } }
# print "# finding optimal pairing\n";

  { # block for scope isolation only
    my(@choice, $opp, $oppid);

    # mark all players as initially unpaired
    # 'opp' points to the provisional opponent
    for my $p (@$unpairedp) { $p->{'opp'} = -1; }

    # find best opp for each player, favoring top of field
    for (my $i=0; $i<=$#$unpairedp; ) {
      my $p = $unpairedp->[$i];
      if ($p->{'opp'} >= 0)
        { $i++; next; } # player has already been paired - skip

      # go to head of preference list if visiting player for first time
      $choice[$i] = -1 unless defined $choice[$i];

      # try the next preferred opp for this player.
      $opp = $p->{'pref'}[++$choice[$i]];

      if (!defined $opp) {
# print '.' x $i, "$p->{'name'} can't be paired, climbing back up from i=$i to i=";
        for ($choice[$i]=undef; $i>=0 && !defined $choice[$i]; $i--) { }
# print "$i.\n";
        if ($i < 0) {
          print "Walked entire tree, couldn't find acceptable pairing.\n";
          return 0;
          }

        # find last paired player's opponent, which now has to be unpaired
        my $opp = $unpairedp->[$i]{'pref'}[$choice[$i]];
        # unpair opponent from that player
        $opp->{'opp'} = -1;
        # unpair that player from the opponent
        $unpairedp->[$i]{'opp'} = -1;
        next;
        } # if (!defined $opp) - we've run out of opps, back up

# print '.' x $i, "$p->{'name'} has pairing vector @{$p->{'pref'}}.\n";
# print ' ' x $i, " trying to pair $p->{'name'}, choice $choice[$i] is ",
# defined $opp ? "$opp->{'name'} ($opp->{'id'})" : 'undef', "\n";

      if ($opp->{'opp'} >= 0) {
# print ' ' x $i, " but $opp->{'name'} has already been paired.\n";
        next;
        }

      # looks good so far, let's try to keep going
      $p->{'opp'} = $opp->{'id'};
      $opp->{'opp'} = $p->{'id'};
      $i++;
      } # for $i
    }
  # copy provisional opponents to pairings
  for my $i (0..$#$unpairedp) {
    my $p = $unpairedp->[$i];
    push(@{$p->{'pairings'}}, $p->{'opp'});
    }
  1;
  } # sub ResolvePairings

sub SortByStanding ($@) {
  my $sr0 = shift;

  $gKeyRound = $sr0; 
    my (@sorted) = sort bystanding @_;
  $gKeyRound = undef;
  return @sorted;
  }

sub SpliceInactive (\@;$) {
  my $psp = shift;
  my $count = shift || 1;

  for (my $i=0; $i<=$#$psp; $i++) {
    my $p = $psp->[$i];
    my $off = $p->{'etc'}{'off'};
    next unless defined $off;
    splice(@$psp, $i--, 1);
    push(@{$p->{'pairings'}}, 0);
    push(@{$p->{'scores'}}, ($off->[0]) x $count);
    }
  }

# update internal stats on division
sub SynchDivision ($) {
  my ($dp) = @_;
  my $datap = $dp->{'data'};

  my $minpairs = 999999;
  my $maxpairs = -1;
  my $maxscores = -1;
  my $maxs_player = undef;

  for my $i (1..$#$datap) {
    my $p = $datap->[$i];
    my $pairingsp = $p->{'pairings'};
    my $npairs = $#$pairingsp;
    my $nscores = $#{$p->{'scores'}};
    my $spread = 0;
    my (@spread) = ();
    my $ratedgames = 0; 
    my $ratedwins = 0; 
    my $wins = 0;
    my (@wins) = ();

# print "$p->{id} has $nscores+1 scores.\n" if $nscores > $maxscores;
# print "$p->{id} has $npairs+1 opponents.\n" if $npairs > $maxpairs;
    $minpairs = $npairs if $npairs < $minpairs;
    $maxpairs = $npairs if $npairs > $maxpairs;
    if ($nscores > $maxscores) {
      $maxscores = $nscores;
      $maxs_player = $p->{'name'};
#     print join(' ', $p->{'name'}, $nscores, @{$p->{'scores'}}), "\n";
      }

    for my $j (0..$nscores) { # number of scores
      my $opp = $pairingsp->[$j];
      if (!defined $opp) {
        printf "Oops: %s has a score but no opp in round 1+$j.\n", (TaggedName $p);
        }
      else {
	my $oppscore;
	if ($opp) {
	  $oppscore = $datap->[$opp]{'scores'}[$j];
	  $ratedgames++;
	  }
	else {
	  $oppscore = 0;
	  }
print "j=$j pid=$p->{'id'} opp=$opp\n" unless defined $p->{'scores'}[$j];
        my $thisSpread = $p->{'scores'}[$j] - $oppscore;
        $spread += $thisSpread;
        push(@spread, $spread);
	my $result = (1 + ($thisSpread <=> 0))/2;
        $wins += $result;
	$ratedwins += $result if $opp;
        push(@wins, $wins);
        }
      } # for $j
    $p->{'rspread'} = \@spread;
    $p->{'rwins'} = \@wins;
    $p->{'spread'} = $spread;
    $p->{'ratedwins'} = $ratedwins;
    $p->{'ratedgames'} = $ratedgames;
    $p->{'wins'} = $wins;

    { my @repeats;
      for my $j (1..$#$datap) { $repeats[$j] = 0; }
      for my $j (@$pairingsp) { $repeats[$j]++; }
      $p->{'repeats'} = \@repeats;
    }

    }

  $dp->{'maxs'} = $maxscores;
  $dp->{'maxs_player'} = $maxs_player;
  $dp->{'maxp'} = $maxpairs;
  $dp->{'minp'} = $minpairs;

  if ($config'track_firsts) { # must come after maxp computation
    SynchFirsts $dp;
    }
  }

# Firsts and seconds are coded in $p->{'etc'}{'p12'} as follows
#
# 0: bye
# 1: first
# 2: second
# 3: must draw
# 4: indeterminate pending prior draws
sub SynchFirsts ($) {
  my $dp = shift;
  my $datap = $dp->{'data'};

  for my $p (@$datap[1..$#$datap]) {
    $p->{'p1'} = $p->{'p2'} = $p->{'p3'} = $p->{'p4'} = 0;
    }

  for my $round0 (0..$dp->{'maxp'}) {
    for my $p (@$datap[1..$#$datap]) {
      my $opp = $p->{'pairings'}[$round0];
      next unless defined $opp;
      if ($opp == 0) { $p->{'etc'}{'p12'}[$round0] = 0; next; }
      next if $opp < $p->{'id'};
      $opp = $datap->[$opp];
      my $p12p = $p->{'etc'}{'p12'};
      my $o12p = $opp->{'etc'}{'p12'};
      my $exists = 1;
      my $p12 = $p12p->[$round0];
      my $o12 = $o12p->[$round0];
      if ($p12 && $p12 < 4) {
	if (!(defined $o12 && $o12 < 4)) 
	  { $o12p->[$round0] = (0, 2, 1, 3)[$p12]; }
        }
      elsif (defined $o12 && $o12 < 4) {
	$p12p->[$round0] = (0, 2, 1, 3)[$o12];
        }
      else { $exists = 0; }
      if ($exists) { 
	$p->{"p$p12p->[$round0]"}++;
	$opp->{"p$o12p->[$round0]"}++;
	next;
        }
      # otherwise, see if we can deduce first/second
      my $ofuzz = $opp->{'p3'} + $opp->{'p4'};
      my $pfuzz = $p->{'p3'} + $p->{'p4'};
      if ($pfuzz + $ofuzz == 0 || $round0 == 0) {
	my $which = 1 +
	  ($p->{'p1'} <=> $opp->{'p1'} || $opp->{'p2'} <=> $p->{'p2'});
#  print "$p->{'name'} $p->{'p1'} $p->{'p2'} $opp->{'name'} $opp->{'p1'} $opp->{'p2'} $which\n";
	if ($which == 1 && $config'assign_firsts) {
	  $which = 2 * int(rand(2));
	  }
        $p12 = (1, 3, 2)[$which];
        $o12 = (2, 3, 1)[$which];
        }
      # else there's fuzz, so we could get 4s
      else {
	my $diff1 = $p->{'p1'} - $opp->{'p1'};
	my $diff2 = $p->{'p2'} - $opp->{'p2'};
	if (($diff1 <=> $ofuzz || -$diff2 <=> $pfuzz) > 0) 
	  { $p12 = 1; $o12 = 2; }
	elsif ((-$diff1 <=> $pfuzz || $diff2 <=> $ofuzz) > 0) 
  	  { $p12 = 2; $o12 = 1; }
	elsif ($config'assign_firsts) {
	  if (rand(1) > 0.5) { $p12 = 1; $o12 = 2; }
	  else { $p12 = 2; $o12 = 1; }
	  }
	else 
	  { $p12 = $o12 = 4; } 
        }

      $p->{'etc'}{'p12'}[$round0] = $p12;
      $opp->{'etc'}{'p12'}[$round0] = $o12;
      $p->{"p$p12"}++;
      $opp->{"p$o12"}++;
      }
    }
  }

sub TaggedName ($) {
  my ($p) = @_;
  my $clean_name = $p->{'name'} || ''; 
  $clean_name =~ s/,$//; # kludge to allow names ending in digits
  defined $p && length($clean_name)
    ? "$clean_name (\U$p->{'division'}{'name'}\E$p->{'id'})"
    : 'nobody';
  }

sub UpdateDivisions ($) {
  my $divsp = shift;
  for my $dname (keys %$divsp) {
    print "Updating Division $dname\n";
    SynchDivision $gDivision{lc $dname}; 
    WriteDivision $gDivision{lc $dname}; 
    delete $divsp->{$dname};
    }
  }

sub WriteDivision ($) {
  my ($dp) = @_;
  my $i;

  rename $dp->{'file'}, ("$config'backup_directory$dp->{'file'}.".time)
    || die "Can't backup division ($!).\n";
  open(OUT, ">$dp->{'file'}") 
    || die "Can't create division ($!).\n";
  &MacPerl'SetFileInfo('McPL', 'TEXT', $dp->{'file'}) if defined &MacPerl'SetFileInfo;
  for my $p (@{$dp->{'data'}}) {
    if (defined $p && defined $p->{'id'} && $p->{'id'}) {
      printf OUT "%-22s %4d %s; %s",
        $p->{'name'},
        $p->{'rating'},
        join(' ', @{$p->{'pairings'}}),
        join(' ', @{$p->{'scores'}});
      if ($p->{'etc'}) {
	my $etcp = $p->{'etc'};
	for my $key (sort keys %$etcp) {
	  my $wordsp = $etcp->{$key};
	  print OUT "; $key @$wordsp";
	  }
        }
      print OUT "\n";
      }
    }
  close(OUT);
}

## main code

Main;

