#!/usr/bin/perl

# Copyright (C) 2007-2008 John J. Chew, III <jjchew@math.utoronto.ca>
# All Rights Reserved

package TSH::Command::RoundRATings;

use strict;
use warnings;

use TSH::Log;
use TSH::Utility qw(Debug DebugOn FormatHTMLHalfInteger FormatHTMLSignedInteger);

# DebugOn('SP');

our (@ISA) = qw(TSH::Command);

=pod

=head1 NAME

TSH::Command::RoundRATings - implement the C<tsh> RoundRATings command

=head1 SYNOPSIS

  my $command = new TSH::Command::RoundRATings;
  my $argsp = $command->ArgumentTypes();
  my $helptext = $command->Help();
  my (@names) = $command->Names();
  $command->Run($tournament, @parsed_arguments);
  
=head1 ABSTRACT

TSH::Command::RoundRATings is a subclass of TSH::Command.

=cut

=head1 DESCRIPTION

=over 4

=cut

sub initialise ($@);
sub new ($);
sub RenderAll ($$$$);
sub RenderPlayer ($$$);
sub RenderTable ($$$$);
sub Run ($$@);
sub SetupOptions ($$$);

my (%field_info) = (
  'class' => { 'class' => 'class', 'text_key' => 'Cl', 'html_key' => 'Class',
    'render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      return $p->Class();
      } },
  'drat' => { 'class' => 'rating difr', 'text_key' => sub { $_[0]{'difrt'}}, 'html_key' => sub { $_[0]{'difrh'}},
    'html_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      my $rating = $p->Rating();
      my $newr = $r0 >= 0 ? $p->NewRating($r0) : $rating;
      return $rating ? $p->Division()->RatingSystem()->RenderRatingDifference($newr, $rating, {'style' => 'html'}) : '&nbsp;';
      },
    'text_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      my $rating = $p->Rating();
      my $newr = $r0 >= 0 ? $p->NewRating($r0) : $rating;
      return $rating ? $p->Division()->RatingSystem()->RenderRatingDifference($newr, $rating, {'style' => 'text'}) : ' ';
      } },
  'name' => { 'class' => 'name', 'text_key' => 'Player', 'html_key' => 'Player',
    'html_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      return $p->TaggedName('print');
      },
    'text_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      return $p->TaggedName();
      } },
  'last' => { 'class' => 'last', 'text_key' => 'Last_G', 'html_key' => 'Last_Game',
    'render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $config = $myconfigp->{'config'};
      my $r0 = $myconfigp->{'r0'};
      my $s = '';
      my $opp = $p->Opponent($r0);
      if ($opp) {
	my $oname = $myconfigp->{'showlastplayername'}
	  ? $opp->TaggedName() : $opp->FullID();
	my $ms = $p->Score($r0);
	if (defined $ms) {
	  my $os = $p->OpponentScore($r0);
	  $os = 0 unless defined $os; # possible if pairing data bad
	  my $p12 = $p->First($r0);
	  $s = 
	    ($myconfigp->{'trackfirsts'} ? substr('B12??', $p12,1) : '')
	    .($myconfigp->{'spreadentry'} 
	      ? '' : ($ms > $os ? 'W' : $ms < $os ? 'L' : 'T'));
	  $s .= ':' if $s;
	  $s .=($myconfigp->{'spreadentry'} 
	    ? sprintf("%+d:", $ms-$os) : "$ms-$os:") unless $myconfigp->{'no_scores'};
	  $s .= "$oname";
	  }
	else {
	  $s = $config->Terminology('pending') . ":$oname";
	  }
	}
      else {
	if (defined $p->OpponentID($r0)) {
	  $s = $config->Terminology('bye');
	  }
	else {
	  $s = $config->Terminology('unpaired');
	  }
	}
      return $s;
      } },
  'next' => { 'class' => 'next', 'text_key' => '', 'html_key' => sub { $_[1]->{'dp'}->LastPairedRound0() > $_[1]->{'r0'} ? 'Next_Game' : undef},
    'html_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $config = $myconfigp->{'config'};
      my $r0 = $myconfigp->{'r0'};
      if (my $max_rounds = $config->Value('max_rounds')) {
	if ($r0+1 >= $max_rounds) {
	  return undef;
	  }
	}
      my $oid = $p->Opponent($r0+1);
      if (!defined $oid) { return undef; }
      return $p->Division()->FormatPairing($r0+1, $p->ID(), {'style' => 'nextrat'});
      # TODO: dead code if the preceding line is acceptable in testing
      my $opp = $p->Opponent($r0+1) or return $config->Terminology('bye');
      my $s = $opp->FullID();
      if ($config->Value('seats')) {
	$s .= '@' . $p->Seat($r0+1);
	}
      return $s;
      },
    'text_render' => sub {
      return undef;
      } },
  'nrat' => { 'class' => 'rating newr', 'text_key' => sub { $_[0]{'newrt'}}, 'html_key' => sub { $_[0]{'newrh'} }, 
    'html_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      return $p->Division()->RatingSystem()->RenderRating($r0 >= 0 ? $p->NewRating($r0) : $p->Rating(), {'style' => 'html'});
      },
    'text_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      return $p->Division()->RatingSystem()->RenderRating($r0 >= 0 ? $p->NewRating($r0) : $p->Rating(), {'style' => 'text'});
      },
      },
  'orat' => { 'class' => 'rating oldr', 'text_key' => sub { $_[0]{'oldrt'}}, 'html_key' => sub { $_[0]{'oldrh'}}, 
    'html_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      return $p->Division()->RatingSystem()->RenderRating($p->Rating(), {'style' => 'html'});
      },
    'text_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      return $p->Division()->RatingSystem()->RenderRating($p->Rating(), {'style' => 'text'});
      },
      },
  'rank' => { 'class' => 'rank', 'text_key' => 'Rnk', 'html_key' => 'Rank', 
    'render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      return $myconfigp->{'is_capped'}
        ? $p->RoundCappedRank($r0) : $p->RoundRank($r0);
      } },
  'scoresum' => { 'class' => 'sum', 'text_key' => 'ScrSum', 'html_key' => 'ScoreSum', 
    'render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      return $p->RoundSum($r0);
      } },
  'spread' => { 'class' => 'spread', 'text_key' => 'Sprd', 'html_key' => 'Spread', 
    'html_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      my $spread = sprintf(
	$myconfigp->{'positive_scores'} ? '%d' : "%+d", $myconfigp->{'is_capped'}
	? $p->RoundCappedSpread($r0) : $p->RoundSpread($r0));
      return FormatHTMLSignedInteger($spread);
      },
    'text_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      my $spread = sprintf(
	$myconfigp->{'positive_scores'} ? '%d' : "%+d", $myconfigp->{'is_capped'}
	? $p->RoundCappedSpread($r0) : $p->RoundSpread($r0));
      return $spread;
      } },
  'team' => { 'class' => 'team', 'text_key' => 'Team', 'html_key' => 'Team',
    'render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      return $p->Team() || '-';
      } },
  'thaipoints' => { 'class' => 'thai', 'text_key' => 'thaipts', 'html_key' => 'thaipoints', 
    'render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      return 2*$p->RoundWins($r0)+($p->GetOrSetEtcScalar('handicap')||0);
      } },
  'wl' => { 'class' => 'wl', 'text_key' => 'W_L', 'html_key' => 'Won_Lost', 
    'html_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      my $w = $p->RoundWins($r0);
      my $l = $p->RoundLosses($r0);
      return FormatHTMLHalfInteger($w) . '&ndash;' . FormatHTMLHalfInteger($l);
      },
    'text_render' => sub {
      my $p = shift @_;
      my $myconfigp = shift @_;
      my $r0 = $myconfigp->{'r0'};
      my $w = $p->RoundWins($r0);
      my $l = $p->RoundLosses($r0);
      return sprintf("%.1f-%.1f", $w, $l);
      } },
  );

=item $parserp->initialise()

Used internally to (re)initialise the object.

=cut

sub initialise ($@) {
  my $this = shift;

  $this->SUPER::initialise(@_);
  $this->{'help'} = <<'EOF';
Use this command to display ratings estimates based on standings
in a given round or rounds within a division.  If you specify
just one round, the results will be displayed on the screen.
If you specify a range of rounds (e.g., 4-7), the results will
not be shown on your screen but report files will be updated.
EOF
  $this->{'names'} = [qw(rrat roundratings)];
  $this->{'argtypes'} = [qw(RoundRange Division)];

  return $this;
  }

sub new ($) { return TSH::Utility::new(@_); }

sub RenderAll ($$$$) {
  my $dp = shift;
  my $firstr1 = shift;
  my $lastr1 = shift;
  my $optionsp = shift;
  my $lastr0 = $lastr1 - 1;
  my $tournament = $dp->Tournament();
  $dp->CountPlayers() or return 0;
  $dp->CheckRoundHasResults($lastr0) or return 0;

  for my $r1 ($firstr1..$lastr1-1) {
    my $r0 = $r1 - 1;
    $tournament->TellUser('irratok', $r1);
#   warn $r0;
    $dp->ComputeRatings($r0) unless $optionsp->{'no_ratings'};
    RenderTable $dp, $r0, $optionsp, 1;
    }
  $dp->ComputeRatings($lastr0, $optionsp->{'noconsole'}) if $lastr0 >= 0;

  RenderTable $dp, $lastr0, $optionsp, $optionsp->{'noconsole'};
  }

=item RenderPlayer($logp, $pp, \%myconfig);

Render a row of a ratings table.

=cut

sub RenderPlayer ($$$) {
  my $logp = shift;
  my $p = shift;
  my $myconfigp = shift;

  my $r0 = $myconfigp->{'r0'};
  my $config = $myconfigp->{'config'};

#   if ($config::pair_page_break && $i && ($i) % $config::pair_page_break == 0) { $logp->Write('',qq(</table><table class=ratings align=center cellspacing=0 style="page-break-before:always"><tr>$headings</tr>)); }
  my @html_fields;
  my @text_fields;

  for my $field (@{$myconfigp->{'fields'}}) {
    my $fip = $field_info{$field};
    my $render = $fip->{'render'};
    my $html_render = $fip->{'html_render'} || $render;
    my $text_render = $fip->{'text_render'} || $render;
    my $s = &$text_render($p, $myconfigp);
    push(@text_fields, $s) if (defined $s) && length($s);
    $s = &$html_render($p, $myconfigp);
    push(@html_fields, $s) if (defined $s) && length($s);
    }
  $logp->WriteRow(\@text_fields, \@html_fields);
  }

=item RenderTable($dp, $r0, $optionsp, $noconsole)

Render the rows of the ratings table. This code is independent of
rating system.

=cut

sub RenderTable ($$$$) {
  my $dp = shift;
  my $r0 = shift;
  my $optionsp = shift;
  my $noconsole = shift;
  my $tournament = $dp->Tournament();
  my $config = $tournament->Config();
  if ($optionsp->{'no_ratings'}) {
    $optionsp->{'oldrh'} = $optionsp->{'newrh'} = $optionsp->{'difrh'} = undef;
    }
  my (%myconfig) = (%$optionsp);
  $myconfig{'config'} = $config;
  $myconfig{'dp'} = $dp;
  $myconfig{'has_classes'} = $dp->Classes() || defined $dp->Player(1)->Class();
  $myconfig{'has_sum'} = $config->Value('sum_before_spread');
  $myconfig{'show_inactive'} = $config->Value('show_inactive');
  $myconfig{'no_scores'} = ($config->Value('scores')||'') =~ /^WLT?$/i;
  $myconfig{'is_capped'} = $config->Value('standings_spread_cap') || $config->Value('spread_cap');
  $myconfig{'noshowlast'} = $config->Value('no_show_last') || $r0 < 0;
  $myconfig{'r0'} = $r0;
  $myconfig{'showlastplayername'} = $config->Value('show_last_player_name');
  $myconfig{'spreadentry'} = $config->Value('entry') eq 'spread';
  $myconfig{'thaipoints'} = $config->Value('thai_points');
  $myconfig{'trackfirsts'} = $config->Value('track_firsts');
  $optionsp->{'order'} ||= 'rating';

  $myconfig{'fields'} = $config->Value('rating_fields') || do {
    my (@fields) = qw(rank);
    push(@fields, 'wl') unless $myconfig{'no_wl'};
    push(@fields, 'scoresum') if $myconfig{'has_sum'};
    push(@fields, 'spread') unless $myconfig{'no_scores'};
    push(@fields, 'thaipoints') if $myconfig{'thaipoints'};
    push(@fields, 'orat') if $myconfig{'oldrh'};
    push(@fields, 'nrat') if $myconfig{'newrh'};
    push(@fields, 'drat') if $myconfig{'difrh'};
    push(@fields, 'class') if $myconfig{'has_classes'};
    push(@fields, 'name');
    push(@fields, 'last') unless $myconfig{'noshowlast'};
    push(@fields, 'next') if $dp->LastPairedRound0() > $r0;
    \@fields;
    };

  my $logp = new TSH::Log($tournament, $dp, 
    ($optionsp->{'filename'} || 'ratings'),
    $r0+1,
    {
      'noconsole' => $noconsole,
      %$optionsp,
    },
    );
  my (@classes);
  my @html_titles;
  my @text_titles;
  for my $field (@{$myconfig{'fields'}}) {
    my $fip = $field_info{$field};
    unless ($fip) {
      warn "Unknown field '$field' in config rating_fields, ignoring";
      next;
      }
    push(@classes, $fip->{'class'});
    my $key = $fip->{'html_key'};
    $key = &$key($optionsp, \%myconfig) if ref($key) eq 'CODE';
    push(@html_titles, $config->Terminology($key)) if (defined $key) && length($key);
    $key = $fip->{'text_key'};
    $key = &$key($optionsp, \%myconfig) if ref($key) eq 'CODE';
    push(@text_titles, $config->Terminology($key)) if (defined $key) && length($key);
    }
  $logp->ColumnClasses(\@classes);
  $logp->ColumnTitles(
    {
    'text' => \@text_titles,
    'html' => \@html_titles,
    }
    );
  my @player_groups;
  if ($myconfig{'has_classes'} && $optionsp->{'byclass'}) {
    my %byclass;
    for my $p ($dp->Players()) {
      my $class = $p->Class();
      $class = 'none' unless defined $class;
      push(@{$byclass{$class}}, $p);
      }
    for my $class (sort keys %byclass) {
      push(@player_groups, $byclass{$class});
      }
    }
  else {
    $player_groups[0] = [$dp->Players()];
    }
  for my $i (0..$#player_groups) {
    my $psp = $player_groups[$i];
    if ($i > 0) {
      my (@blank) = ('') x @text_titles;
      $logp->WriteRow(\@blank, \@blank);
      }
    my @ps;
    if ($myconfig{'is_capped'}) {
      $dp->ComputeCappedRanks($r0, {'show_inactive'=>$myconfig{'show_inactive'}});
      if ($optionsp->{'order'} eq 'handicap') {
	@ps = TSH::Player::SortByHandicap($r0, @$psp);
	}
      else {
	@ps = TSH::Player::SortByCappedStanding($r0, @$psp);
	}
      }
    else {
      $dp->ComputeRanks($r0, {'show_inactive'=>$myconfig{'show_inactive'}});
      if ($optionsp->{'order'} eq 'handicap') {
	@ps = TSH::Player::SortByHandicap($r0, @$psp);
	}
      else {
	@ps = TSH::Player::SortByStanding($r0, @$psp);
	}
      }
    for my $p (@ps) {
      next unless $p->Active() || $myconfig{'show_inactive'};
      RenderPlayer $logp, $p, \%myconfig;
      }
    }
  my $origfn = $logp->Filename();
  $logp->Close();

  my $copyfn = $origfn;
  $copyfn =~ s/-\d+\././;
  TSH::Utility::UpdateFile(
    $config->MakeHTMLPath($origfn), $config->MakeHTMLPath($copyfn));
  }

=item $command->Run($tournament, @parsed_args)

Should run the command in the context of the given
tournament with the specified parsed arguments.

=cut

sub Run ($$@) { 
  my $this = shift;
  my $tournament = shift;
  my ($firstr1, $lastr1, $dp) = @_;
  my $config = $tournament->Config();
  my $optionsp = SetupOptions($config, $dp, $this->{'noconsole'});

  RenderAll($dp, $firstr1, $lastr1, $optionsp);
  return 0;
  }

sub SetupOptions ($$$) {
  my $config = shift;
  my $dp = shift;
  my $noconsole = shift;

  my (%options_by_rating_system) = (
    'nsa' => {
      'titlename' => 'Ratings',
      'oldrh'=>'Old_Rating',
      'oldrt'=>'Old_R',
      'newrh'=>'New_Rating',
      'newrt'=>'New_R',
      'difrh'=>'Rating_Change',
      'difrt'=>'Rating_Ch',
      },
    'none' => {
      'titlename' => 'Rankings',
      },
    );
  
  my (%options) = %{$options_by_rating_system{lc $dp->RatingSystemName()}
    || $options_by_rating_system{'nsa'}};

  if (($config->Value('pairing_system')||'') eq 'none') {
#   $options{'no_ratings'} = 1;
    $options{'no_wl'} = 1;
    $options{'noshowlast'} = 1;
    $options{'positive_scores'} = 1;
    }
  $options{'noconsole'} = $noconsole;
  $options{'refresh'} = $config->Value('standings_refresh');

  return \%options;
  }

=back

=cut

1;
