#!/usr/bin/perl
#
#    fide2009.pl - Calcul des perfs et variations de Elo FIDE suivant les
#    règles en vigueur au 1er juillet 2009.
#    Copyright © 2009 Thomas Lemoine <thomas.lemoine@free.fr>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;

use File::Glob;
use HTML::PullParser;

my @prime = (
	-800, -677, -589, -538, -501, -470, -444, -422, -401, -383,
	-366, -351, -336, -322, -309, -296, -284, -273, -262, -251,
	-240, -230, -220, -211, -202, -193, -184, -175, -166, -158,
	-149, -141, -133, -125, -117, -110, -102,  -95,  -87,  -80,
	 -72,  -65,  -57,  -50,  -43,  -36,  -29,  -21,  -14,   -7
);

my @pronostic = (
	  3,  10,  17,  25,  32,  39,  46,  53,  61,  68,
	 76,  83,  91,  98, 106, 113, 121, 129, 137, 145,
	153, 162, 170, 179, 188, 197, 206, 215, 225, 235,
	245, 256, 267, 278, 290, 302, 315, 328, 344, 357,
	374, 391, 411, 432, 456, 484, 517, 559, 619, 735
);

sub pronostic {
	my $ecart = $_[0];
	return (1 - pronostic(-$ecart)) if $ecart < 0;
	$ecart = 400 if $ecart > 400; # Supprimer cette ligne quand la FIDE aura pris des cours de maths
	my $i = 0;
	++$i while $i < 50 and $ecart > $pronostic[$i];
	return ($i + 50) / 100;
}

sub moyenne {
	my $nb = 0;
	my $total = 0;
	for (@_) {
		$total += $_;
		++ $nb;
	}
	return $total / $nb;
}

sub arrondi {
	my $a = int($_[0]);
	++ $a if $_[0] - $a >= 0.5;
	return $a;
}

sub denbspise {
	$_[0] =~ s/&nbsp;/ /g;
	return $_[0];
}

sub trim {
	$_[0] =~ s/^\s+//;
	$_[0] =~ s/\s+$//;
	return $_[0];
}

my @grilles = <*Ga.htm>;

for my $grille (@grilles) {
	my $liste = $grille;
	$liste =~ s/Ga\.htm$/Ls.htm/;
	if (-e $liste) {
		my $dest = $grille;
		$dest =~ s/Ga\.htm$/FideThL.htm/;
		
		# Liste des joueurs
		
		my $parser = HTML::PullParser->new(
			file            => $liste,
			start           => '"S", tagname, attr',
			end             => '"E", tagname',
			text            => '"T", text',
			ignore_elements => [qw(script style)]
		) or die "Impossible d'ouvrir le fichier : $!";
		
		my $token;
		
		my %titre;
		my %elo;
		my %type;
		my %fede;
		
		while ($token = $parser->get_token) {
			next unless $$token[0] eq "S";
			next unless $$token[1] eq "tr";
			next unless $$token[2]{'class'} eq "papi_liste_f" or $$token[2]{'class'} eq "papi_liste_c";
			my @temp;
			while ($token = $parser->get_token) {
				if ($$token[0] eq "S" and $$token[1] eq "td") {
					$token = $parser->get_token while $$token[0] ne "T";
					my $temp;
					while ($$token[0] eq "T") {
						$temp .= denbspise($$token[1]);
						$token = $parser->get_token;
					}
					push @temp, trim($temp);
				}
				elsif ($$token[0] eq "E" and $$token[1] eq "tr") {
					# Contenu de @temp : numéro, titre, nom, elo+type, catégorie, fédération, ligue, club
					$titre{$temp[2]} = $temp[1];
					($elo{$temp[2]}, $type{$temp[2]}) = split /\s/, $temp[3];
					$fede{$temp[2]} = $temp[5];
					last;
				}
			}
		}
		
		# Grille américaine
		
		$parser = HTML::PullParser->new(
			file            => $grille,
			start           => '"S", tagname, attr',
			end             => '"E", tagname',
			text            => '"T", text',
			ignore_elements => [qw(script style)]
		) or die "Impossible d'ouvrir le fichier : $!";
		
		my $tournoi;
		my $ronde;
		
		while ($token = $parser->get_token) {
			next unless $$token[0] eq "S";
			next unless $$token[1] eq "title";
			$token = $parser->get_token;
			($tournoi, $ronde) = split / - Grille américaine après la ronde /, $$token[1];
			last;
		}
		
		my %place;
		my @place;
		my %resultat;
		
		while ($token = $parser->get_token) {
			next unless $$token[0] eq "S";
			next unless $$token[1] eq "tr";
			next unless $$token[2]{'class'} eq "papi_small_c" or $$token[2]{'class'} eq "papi_small_f";
			my @temp;
			while ($token = $parser->get_token) {
				if ($$token[0] eq "S" and $$token[1] eq "td") {
					$token = $parser->get_token while $$token[0] ne "T";
					my $temp;
					while ($$token[0] eq "T") {
						$temp .= denbspise($$token[1]);
						$token = $parser->get_token;
					}
					push @temp, trim($temp);
				}
				elsif ($$token[0] eq "E" and $$token[1] eq "tr") {
					# Contenu de @temp : place, titre, nom, elo, catégorie, fédération, ligue, rondes, score, départages, perf ?
					$place[$temp[0]] = $temp[2];
					$place{$temp[2]} = $temp[0];
					@{$resultat{$temp[2]}} = @temp[7 .. $ronde + 6];
					last;
				}
			}
		}
		
		my %moyAdv;
		my %score;
		my %nbP;
		
		# Première passe : les non classés
		
		my %perf;
		my %valide;
		
		for (keys %elo) {
			next if $type{$_} eq "F";
			my @adversaires;
			my $score = 0;
			for (@{$resultat{$_}}) {
				if (/(\+|=|-)(\d*)/) {
					if ($type{$place[$2]} eq "F") {
						push @adversaires, $elo{$place[$2]};
						if ($1 eq "+") {
							$score += 1;
						}
						elsif ($1 eq "=") {
							$score += 0.5;
						}
					}
				}
			}
			$score{$_} = $score;
			$nbP{$_} = @adversaires;
			next if $nbP{$_} == 0;
			$moyAdv{$_} = arrondi(moyenne(@adversaires));
			if ($nbP{$_} < 3) {
				$valide{$_} = 0;
				next;
			}
			$valide{$_} = $score{$_} < 1 ? 0 : 1;
			if ($score{$_} < $nbP{$_} * 0.5) {
				my $pourcentage = arrondi(100 * $score{$_} / $nbP{$_});
				$perf{$_} = $moyAdv{$_} + $prime[$pourcentage];
			}
			else {
				$perf{$_} = arrondi($moyAdv{$_} + 25 * ($score{$_} - $nbP{$_} / 2));
			}
			$valide{$_} = 0 if $perf{$_} < 1200;
		}
		
		# Deuxième passe : les classés
		
		for (keys %elo) {
			next if $type{$_} ne "F";
			my @adversaires;
			my $score = 0;
			my $perf = 0;
			my $elo = $elo{$_};
			for (@{$resultat{$_}}) {
				if (/(\+|=|-)(\d*)/) {
					my $adversaire;
					if ($type{$place[$2]} eq "F") {
						$adversaire = $elo{$place[$2]};
					}
					#elsif ($valide{$place[$2]}) {
					#	$adversaire = $perf{$place[$2]};
					#}
					else {
						next;
					}
					push @adversaires, $adversaire;
					my $scoreUnitaire = 0;
					if ($1 eq "+") {
						$scoreUnitaire = 1;
					}
					elsif ($1 eq "=") {
						$scoreUnitaire = 0.5;
					}
					$score += $scoreUnitaire;
					$perf += 10 * ($scoreUnitaire - pronostic($elo - $adversaire));
				}
			}
			$perf{$_} = $perf;
			$score{$_} = $score;
			$nbP{$_} = @adversaires;
			next if $nbP{$_} == 0;
			$moyAdv{$_} = arrondi(moyenne(@adversaires));
		}
		
		# Troisième passe : résultat
		
		open FIDE, ">$dest";
		
		print FIDE <<HTML;
<html>
<head>
<meta http-equiv='Content-Type' content='text/html; charset=iso-8859-1'><title>$tournoi - Performances FIDE après la ronde $ronde</title>
<style type='text/css'>
 .papi_liste_c {font-family:Arial; font-size:10pt; color: #000000; background-color: #FFFFFF;}
 .papi_liste_f {font-family:Arial; font-size:10pt; color: #000000; background-color: #E0E0E0;}
 .papi_liste_t {font-family:Arial; font-size:10pt; color: #000000; background-color: #FFFFFF; font-weight: bold;}
 .papi_small_c {font-family:Arial; font-size:8pt; color: #000000; background-color: #FFFFFF;}
 .papi_small_f {font-family:Arial; font-size:8pt; color: #000000; background-color: #E0E0E0;}
 .papi_small_t {font-family:Arial; font-size:8pt; color: #000000; background-color: #FFFFFF; font-weight: bold;}
 .papi_titre {font-family:Arial; font-size:12pt; font-weight:bold; height:50px}
 .papi_titre_big {font-family:Arial; font-size:24pt; font-weight:bold;}
</style>
</head>
<body topmargin='4' leftmargin='4'>
<div align='center'>
<table border='0' cellpadding='2' cellspacing='0' bordercolor='#000000'>
 <colgroup>
  <!-- <col align='right'> -->
  <col align='right'>
  <col align='left'>
  <col align='right'>
  <col align='right'>
  <col align='center'>
  <col align='right'>
  <col align='right'>
  <col align='right'>
  <col align='right'>
 </colgroup>
 <tr><td colspan='9' align='center' class='papi_titre'>$tournoi<br>Performances Fide après la ronde $ronde</td></tr>
 <tr class='papi_liste_t'>
  <!-- <td>Nr.</td> -->
  <td>&nbsp;</td>
  <td>Nom</td>
  <td>Elo</td>
  <td>&nbsp;</td>
  <td>Fede</td>
  <td>Points</td>
  <td>Nbr</td>
  <td>Moyenne</td>
  <td>Gain/Perf</td>
 </tr>
HTML
		
		my ($classe1, $classe2) = ("papi_liste_f", "papi_liste_c");
		for (sort keys %elo) {
			next if $nbP{$_} == 0;
			print FIDE " <tr class='$classe1'>\n";
			print FIDE "  <td>$titre{$_}</td>\n";
			print FIDE "  <td>$_</td>\n";
			print FIDE "  <td>$elo{$_}</td>\n";
			print FIDE "  <td>$type{$_}</td>\n";
			print FIDE "  <td>$fede{$_}</td>\n";
			print FIDE "  <td>$score{$_}</td>\n";
			print FIDE "  <td>$nbP{$_}</td>\n";
			print FIDE "  <td>$moyAdv{$_}</td>\n";
			if ($type{$_} eq "F") {
				printf FIDE "  <td>%+.02f</td>\n", $perf{$_};
			}
			elsif (exists $perf{$_} and $valide{$_} == 1) {
				print FIDE "  <td>$perf{$_}</td>\n";
			}
			else {
				print FIDE "  <td>&nbsp;</td>\n";
			}
			print FIDE " </tr>\n";
			($classe1, $classe2) = ($classe2, $classe1);
		}
		
		print FIDE <<HTML;
</table>
<p class='papi_liste_c'><i>ATTENTION : les gains et pertes sont calculés sur la base d'un coefficient 10 pour tous les joueurs, partie par partie, et en tenant compte des performances des adversaires non FIDE, conformément au règlement en vigueur depuis le 1er juillet 2009. La moyenne Elo adverse pour les joueurs classés n'est mentionnée qu'à titre indicatif.</i></p>
</div>
</body>
</html>
HTML
		
		close FIDE;
	}
}
