#!/usr/bin/perl

# Copyright (c) 2009 David Buckley

# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation
# files (the "Software"), to deal in the Software without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following
# conditions:

# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.

use warnings;
use strict;
use Carp;
use DBI;
use Digest::SHA1 qw(sha1_hex);
use Math::Trig;

use POE;
use POE::Component::IRC;

umask 077;

our $game = { lines_sent => 0 };

# Create the component that will represent an IRC network.
our $irc = POE::Component::IRC->spawn();
our $dbi = get_dbi() or die "Could not connect to DB";

# Create the bot session.  The new() call specifies the events the bot
# knows about and the functions that will handle those events.
POE::Session->create(
	inline_states => {
		_start     => \&bot_start,
		register_events => \&register_irc,
		game_tick       => \&game_tick,
		new_game       => \&new_game,
		begin_game       => \&begin_game,
	},
	heap => {
		SERVER => 'codd.uwcs.co.uk',
		CHANNELS => '#SaveThePlanet',
	},
);

# The bot has successfully connected to a server.  Join a channel.
sub on_001 {
	my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];

	my $channels = $heap->{CHANNELS};
	send_msg( join => $channels );
	send_msg( privmsg => $channels, "RESET" );
	if (my $ping_id = $heap->{ping_id}) {
		$irc->delay_remove($ping_id);
		delete $heap->{ping_id};
	}
	$heap->{ping_id} = $irc->delay( [ ping => 'keepalive' ], 30 );
	$kernel->alarm( new_game => time() );
}

sub on_pong {
	my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
	if ($_[ARG0]) {
		print "PONG :$_[ARG0]\n";
	} else {
		print "PONG\n";
	}
	if (my $ping_id = $heap->{ping_id}) {
		$irc->delay_remove($ping_id);
		delete $heap->{ping_id};
	}
	$heap->{ping_id} = $irc->delay( [ ping => 'keepalive' ], 150 );
}

sub register_irc {
	my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
	my %events = (
		irc_001    => \&on_001,
		irc_433    => \&on_nickinuse,
		irc_public => \&on_public,
		irc_ctcp_action => \&on_public,
		irc_msg => \&on_private,
		irc_disconnected => \&on_disconnect,
		irc_pong => \&on_pong,
		irc_raw  => \&on_raw,
		irc_socketerr  => \&on_socketerr,
		reconnect => \&reconnect,
		register_events => \&register,
	);
	for(keys %events) {
		$kernel->state($_, $events{$_});
	}
	if ($_[ARG0]) {
		$kernel->yield('reconnect');
	}
}

sub on_socketerr {
	my ($kernel, $heap, $session, $arg) = @_[ KERNEL, HEAP, SESSION, ARG0 ];
	print "Socket error: $arg\n";
}

sub on_raw {
	my ($kernel, $heap, $session, $arg) = @_[ KERNEL, HEAP, SESSION, ARG0 ];
	print "Raw: $arg\n";
}

sub on_nickinuse {
	my ($kernel, $heap, $session, @arg) = @_[ KERNEL, HEAP, SESSION, ARG0, ARG1, ARG2 ];
	my $nick = $arg[1];
	$nick =~ s/\s.*//;
	$nick .= '0' if $nick !~ /\d$/;
	$nick =~ /(\d+)$/;
	my $num = $1;
	$num++;
	$nick =~ s/\d+$/$num/;
	print "Nick in use; trying $nick.\n";
	send_msg(nick => $nick);
}

sub on_disconnect {
	my ($kernel, $heap, $session) = @_[ KERNEL, HEAP, SESSION ];

	print "Disconnected; trying again in 5 secs.\n";
	sleep 5;
	
	$kernel->post( $session, 'reconnect' );
}

sub reconnect {
	my ($kernel, $heap) = @_[ KERNEL, HEAP ];

	$irc->yield( connect =>
		{
			Nick => 'SaveThePlanet',
			Username => 'stp',
			Ircname  => 'Planet Saver!',
			Server   => $heap->{SERVER},
			Port     => '6667',
			Raw      => 1,
			Flood    => 1,
		}
	);
}

sub get_dbi {
	return $_[0]->{dbi} if exists $_[0]->{dbi};

	open MYCNF, "$ENV{HOME}/.my.cnf";
	local $/;
	my $contents = <MYCNF>;
	close MYCNF;
	my ($user, $database, $password);
	$user = $1 if $contents =~ /user = (.*)/;
	$database = $1 if $contents =~ /database = (.*)/;
	$password = $1 if $contents =~ /password = (.*)/;

	if (!$user || !$database || !$password) {
		die("Sorry, the .my.cnf file appears to be corrupt");
	}

	my $dbh = DBI->connect("dbi:mysql:database=$database", $user, $password);
	$dbh->{mysql_auto_reconnect} = 1;
	$dbh->{mysql_enable_utf8} = 1;
	return $dbh;
}

# The bot has received a public message.  Parse it for commands, and
# respond to interesting things.
sub on_public {
	my ( $kernel, $heap, $who, $where, $msg ) = @_[ KERNEL, HEAP, ARG0, ARG1, ARG2 ];
	my ($nick, $mask) = split /!/, $who;
	my $channel = $where->[0];
	log_irc("<$who:$channel> $msg");
	my $player = get_player($who);
	return unless $player;
	my @bits = split /\s*;\s*/, $msg;
	for (@bits) {
		if (/DONATE (\d+)/i) {
			if (donate($player, $1)) {
				log_game("$player->{name} DONATE $1");
			} else {
				send_msg( notice => $nick, "[201] Not enough resources." );
				print "-> $nick [201] Can't DONATE $1\n";
			}
		} elsif (/INVEST (\d+)/i) {
			if (invest($player, $1)) {
				log_game("$player->{name} INVEST $1");
			} else {
				send_msg( notice => $nick, "[201] Not enough resources." );
				print "-> $nick [201] Can't INVEST $1\n";
			}
		} elsif (/CUTBACK (\d+)/i) {
			if (cutback($player, $1)) {
				log_game("$player->{name} CUTBACK $1");
			} else {
				send_msg( notice => $nick, "[201] Not enough resources." );
				print "-> $nick [201] Can't CUTBACK $1\n";
			}
		}
	}
}

sub on_private {
	my ( $kernel, $heap, $who, $where, $msg ) = @_[ KERNEL, HEAP, ARG0, ARG1, ARG2 ];
	my ($nick, $mask) = split /!/, $who;

	if ($msg =~ /^LOGIN (\S+) (\S+)/i) {
		my $res = $dbi->selectall_arrayref("SELECT player_id, name, password FROM progcomp_stp_players WHERE name = ?", {}, $1);
		if (!$res) {
			confess "Database error: ".$dbi->errstr;
		} elsif (!@$res) {
			send_msg( notice => $nick, "[202] No such user." );
			return;
		}
		my $shouldbe = sha1_hex($game->{id}.$game->{hash}.$res->[0][2]);
		if ($shouldbe eq $2) {
			if (add_player($res->[0][0], $res->[0][1], $who)) {
				send_msg( notice => $nick, "[100] Logged in." );
				log_game("$1 LOGIN $who");
			} else {
				send_msg( notice => $nick, "[200] Sorry, you cannot join the current game." );
			}
		}
		return; # Suppress logging
	} elsif ($msg =~ /^REGISTER (\S+) (.+)/) {
		my $res = $dbi->selectall_arrayref("SELECT player_id FROM progcomp_stp_players WHERE name = ?", {}, $1);
		if (!$res) {
			confess "Database error: ".$dbi->errstr;
		} elsif (@$res) {
			send_msg( notice => $nick, "[203] User exists." );
			return;
		}
		$dbi->do("INSERT INTO progcomp_stp_players SET name = ?, password = ?", {}, $1, $2);
		send_msg( notice => $nick, "[101] User created." );
	}
	log_irc("<$who> $msg");
}

sub game_tick {
	my $kernel  = $_[KERNEL];
	my $heap    = $_[HEAP];
	my $session = $_[SESSION];

	# Prevent disasters and such from occurring on the first tick.
	my $first   = $_[ARG0] || 0;

	# Industry tick.
	my $total_industry = 0;
	my $max_industry = 0;
	for my $player (@{$game->{players}}) {
		next unless $player->{in_game};
		$total_industry += $player->{industry};
		$max_industry = $player->{industry} if $player->{industry} > $max_industry;

		# Industry generates a constant stream of income dependent on the
		# current game parameters.
		$player->{cash} += int(random_normal(1, 0.1) * $player->{industry} * $game->{industry_production})
	}

	if (!$first) {
		# Climate tick. Average is industry - donations, standard deviation is
		# 0.1 times this.
		my $climate_damage = random_normal(1, 0.1) * ($total_industry * $game->{industry_factor} - $game->{donations_this_tick} * $game->{donation_factor});
		$game->{donations_this_tick} = 0;
		$game->{climate_state} += $climate_damage;
		$game->{climate_state} *= $game->{recovery_factor};
		$game->{ticks}++;
	}

	# Disaster/Output tick.
	my (@r, @d);
	my @probs;
	for my $player (@{$game->{players}}) {
		next unless $player->{in_game};
		# Bigger countries are more likely to get owned by disasters.

		my $prob = $game->{climate_state} * (2*$player->{industry}+$game->{industry_capacity}) / (2*$game->{industry_capacity}+$player->{initial_industry});
		push @probs, "$player->{name}=".sprintf("%0.04f", $prob);
		if (rand() < $prob) {
			push @d, disaster($player) unless $first;
		}
		next unless $player->{in_game};
		push @r, "$player->{name}\[i=$player->{industry},c=$player->{cash}]";
	}
	#push @r, "PROBS[".join(",", @probs)."]";

	# Output
	my $buf = "";
	my $start = 1;
	my $lines = 1;
	for(@d) {
		log_game("_ DISASTER $_");
		$buf .= "; " unless $start;
		undef $start;
		$buf .= $_;
		if (length $buf > 350) {
			send_msg( privmsg => "#SaveThePlanet", "DISASTER $buf" );
			$buf = "";
			$start = 1;
		}
	}
	if ($buf) {
		send_msg( privmsg => "#SaveThePlanet", "DISASTER $buf" );
	}

	if (@r == 0) {
		# Planet destroyed
		goto &game_end_bad;
	}

	unshift @r, sprintf("CLIMATE[t=%i,s=%0.04f]", $game->{ticks}, $game->{climate_state});

	$buf = "";
	$start = 1;
	for(@r) {
		log_game("_ STATE $_");
		$buf .= "; " unless $start;
		undef $start;
		$buf .= $_;
		if (length $buf > 350) {
			send_msg( privmsg => "#SaveThePlanet", "STATE $buf" );
			$buf = "";
			$start = 1;
		}
	}
	if ($buf) {
		send_msg( privmsg => "#SaveThePlanet", "STATE $buf" );
	}
	if ($game->{climate_state} <= 0 || $game->{ticks} >= 50 || 
		($total_industry == 0 && $game->{climate_state} < 0.1)) {
		goto &game_end_good;
	}
	send_msg( privmsg => "#SaveThePlanet", "ENDTICK" );
	next_state($kernel, 'game_tick', 3);
}

sub game_end_good {
	for my $player (@{$game->{players}}) {
		$player->{score} = exp((
(($player->{industry} + $player->{cash}/30)/$player->{initial_industry})
       **(1/$game->{ticks})
	   - 1) * 1.5 / $game->{investment_payoff}) / 2;
	   $player->{score} = 0 unless $player->{in_game};
	   $player->{score} = 4 if $player->{score} > 4;
	}
	send_msg( privmsg => "#SaveThePlanet", "GOODEND" );
	$game->{end} = $game->{climate_state} <= 0 ? 'good' : 'medium';
	goto &game_end;
}

sub game_end_bad {
	for my $player (@{$game->{players}}) {
		$player->{score} = sqrt($player->{donation_score} / $player->{initial_industry} / $game->{industry_production} / $game->{ticks}) * 2;
	}
	send_msg( privmsg => "#SaveThePlanet", "BADEND" );
	$game->{end} = 'bad';
	goto &game_end;
}

sub game_end {
	# Update the database with this game's info.
	my $kernel = $_[KERNEL];
	$dbi->do("INSERT INTO progcomp_stp_games SET game_id = ?, begin_time = ?, end_time = ?, ticks = ?, end = ?", {}, $game->{id}, $game->{start_time}, time(), $game->{ticks}, $game->{end});
	my @players = sort { $b->{score} <=> $a->{score} } @{$game->{players}};
	my $pos = 1;
	for my $player (@players) {
		$dbi->do("INSERT INTO progcomp_stp_results SET game_id = ?, player_id = ?, initial_industry = ?, final_industry = ?, final_cash = ?, donation_score = ?, score = ?, position = ?", {}, $game->{id}, $player->{id}, $player->{initial_industry}, $player->{industry}, $player->{cash}, $player->{donation_score}, $player->{score}, $pos);
		$pos++;
	}
	send_msg( privmsg => "#SaveThePlanet", "RESULT ".join(", ", map { sprintf("%s (%0.03f)", $_->{name}, $_->{score}) } @players) );
	send_msg( privmsg => "#SaveThePlanet", sprintf("DEBUG investment_payoff=%0.04f;industry_factor=%0.08f;donation_factor=%0.08f;industry_production=%0.04f;recovery_factor=%0.04f", $game->{investment_payoff}, $game->{industry_factor}, $game->{donation_factor}, $game->{industry_production}, $game->{recovery_factor} ) );
	log_game( "_ RESULT ".join(", ", map { sprintf("%s (%0.03f)", $_->{name}, $_->{score}) } @players) );
	next_state( $kernel, "new_game" );
}

sub new_game {
	my $kernel  = $_[KERNEL];
	$game->{players} = [];
	$game->{player} = {};
	$game->{player_irc} = {};
	$game->{ticks} = 0;
	my $res = $dbi->selectall_arrayref("SELECT MAX(game_id)+1 FROM progcomp_stp_games");
	$game->{id} = $res->[0][0] || 1;
	$game->{hash} = int(rand()*100000);
	send_msg( privmsg => "#SaveThePlanet", "NEW $game->{id}$game->{hash}" );
	next_state( $kernel, "begin_game", 20 );
}

sub begin_game {
	my $kernel  = $_[KERNEL];
	if (@{$game->{players}} < 2) {
		send_msg( privmsg => "#SaveThePlanet", "NEW $game->{id}$game->{hash}" );
		next_state($kernel, "begin_game", 20);
		return;
	}

	if (@{$game->{players}} >= 3) {
		my $desired_nonplayers = int(rand() * (@{$game->{players}} - 1));
		$_->{kill_prob} = 5**$_->{recent_ratio} for @{$game->{players}};
		while($desired_nonplayers > 0) {
			my $total_prob = 0;
			$total_prob += $_->{kill_prob} for @{$game->{players}};
			my $target = rand() * $total_prob;
			for my $num (0..$#{$game->{players}}) {
				$target -= $game->{players}[$num]{kill_prob};
				if ($target <= 0) {
					delete $game->{player}{$game->{players}[$num]{name}};
					delete $game->{player_irc}{$game->{players}[$num]{who}};
					splice @{$game->{players}}, $num, 1;
					last;
				}
			}
			$desired_nonplayers--;
		}
	}

	$game->{start_time} = time();

	# Initialise industry parameter. This can be anything we like provided it's
	# positive. We can ensure this by taking 2^random_normal. - 95% chance of
	# being between 1/2 and 2.
	$game->{industry_production} = 2**(random_normal(0, 0.5));

	# Investment payoff should be about 1/30.
	$game->{investment_payoff} = random_normal(0.03, 0.005);

	# In order to compute likely outcomes, we need to know the total industry.
	# If it's large, a large industry factor will very quickly screw over
	# players, and if it's small, a small industry factor will make it
	# impossible to improve the climate.
	$game->{industry_capacity} = 0;
	for my $player (@{$game->{players}}) {
		$game->{industry_capacity} += $player->{industry};
	}
	$game->{industry_capacity} /= @{$game->{players}};

	# Climate state should start at around 0.1*sqrt(players).
	$game->{climate_state} = random_normal(0.1, 0.02); # * sqrt(@{$game->{players}});

	# Attempt to ensure winning is within reason. The aim is that with all
	# players being completely altruistic (0 score), the game should end in
	# about 10 ticks.

	# Start by working out how many ticks it'll take if industry is clean.
	# This should be about 5 if we assume for now that industry factor is
	# about half of donation factor.
	my $est_ticks_clean = $game->{climate_state} / ($game->{industry_production} * $game->{industry_capacity});

	# To confirm this, ...
	$game->{donation_factor} = 2**random_normal(-0.2, 0.5) * $est_ticks_clean / 7;

	# Now we hope that industry_factor is about half of donation_factor.
	$game->{industry_factor} = 2**random_normal(-1, 0.3) * $game->{donation_factor} * $game->{industry_production};

	# Recovery factor
	$game->{recovery_factor} = random_normal(0.98, 0.005);

	$game->{donations_this_tick} = 0;
	send_msg( privmsg => "#SaveThePlanet", "PLAYERS ".join(",", map { "$_->{nick}=$_->{name}" } @{$game->{players}}) );
	send_msg( privmsg => "#SaveThePlanet", sprintf("CLIMATE industry_factor=%0.08f;donation_factor=%0.08f;recovery_factor=%0.04f", $game->{industry_factor}, $game->{donation_factor}, $game->{recovery_factor} ) );
	send_msg( privmsg => "#SaveThePlanet", "BEGIN" );
	log_game( sprintf("_ DEBUG investment_payoff=%0.04f;industry_factor=%0.08f;donation_factor=%0.08f;industry_production=%0.04f;recovery_factor=%0.04f (this message will be removed)", $game->{investment_payoff}, $game->{industry_factor}, $game->{donation_factor}, $game->{industry_production}, $game->{recovery_factor} ) );
	next_state( $kernel, "game_tick", 0, "first" );
}

sub add_player {
	my ($id, $name, $who) = @_;
	if (@{$game->{players}} >= 20) {
		return;
	}
	my $r = $dbi->selectall_arrayref("SELECT COUNT(*) FROM progcomp_stp_results WHERE player_id = ? AND game_id >= ?", {}, $id, $game->{id} - 30);
	if ($game->{player}{$name}) {
		return;
	}
	my $nick = $who;
	$nick =~ s/!.*//;
	my $player = {
		id => $id,
		name => $name,
		who => $who,
		nick => $nick,
		in_game => 1,
		industry => int(random_normal(1000, 50)), #int(sqrt(rand())*1000),
		donation_score => 0,
		recent_ratio => $r->[0][0],
	};
	$player->{initial_industry} = $player->{industry};
	push @{$game->{players}}, $player;
	$game->{player}{$name} = $player;
	$game->{player_irc}{$who} = $player;
	return 1;
}

sub get_player {
	my ($who) = @_;
	return $game->{player_irc}{$who};
}

sub donate {
	my ($player, $amount) = @_;
	return if $amount > $player->{cash};
	$player->{cash} -= $amount;
	$game->{donations_this_tick} += $amount;
	$player->{donation_score} += $amount;
	return 1;
}

sub invest {
	my ($player, $amount) = @_;
	return if $amount > $player->{cash};
	$player->{cash} -= $amount;
	$player->{industry} += int(random_normal(1, 0.1) * $amount * $game->{investment_payoff});
	return 1;
}

sub cutback {
	my ($player, $amount) = @_;
	return if $amount > $player->{industry};
	$player->{industry} -= $amount;
	return 1;
}

sub disaster {
	my ($player) = @_;
	my $r = rand();
	if ($r < 0.3) {
		my $val = int($player->{industry} * (1-sqrt(rand())));
		$player->{industry} -= $val;
		return "FLOOD[p=$player->{name},v=$val]";
	} elsif ($r < 0.5) {
		$player->{cash} = -50;
		return "SUN_LASER_HITS_MINT[p=$player->{name}]";
	} else {
		# Since all of his industry burns, the world is worse off for the
		# meltdown.
		$game->{climate_state} += random_normal($player->{industry}/$game->{industry_capacity},0.2)*0.05/@{$game->{players}};
		$player->{industry} = 0;
		$player->{cash} = 0;
		$player->{in_game} = 0;
		return "COUNTRY_MELTS[p=$player->{name}]";
	}
}

sub next_state {
	my ($kernel, $state, $delay, @params) = @_;
	$delay ||= 0;
	$delay += $game->{lines_sent} * 0;
	$game->{lines_sent} = 0;
	$kernel->alarm( $state => time() + $delay, @params );
}

sub send_msg {
	my @params = @_;
	$game->{lines_sent}++;
	print "-> Message: @_\n";
	$irc->yield(@_);
}

# The bot session has started.  Register this bot with the "magnet"
# IRC component.  Select a nickname.  Connect to a server.
sub bot_start {
	my $kernel  = $_[KERNEL];
	my $heap    = $_[HEAP];
	my $session = $_[SESSION];

	$irc->yield( register => "all" );

	$kernel->post($session, 'register_events', 1);
}

sub log_irc {
	open IRC_LOG, ">>log_irc";
	print IRC_LOG "[".time()."] $_[0]\n";
	close IRC_LOG;
}

sub log_game {
	open GAME_LOG, sprintf(">>log_game_%06i", $game->{id});
	print GAME_LOG "[".time()."] $_[0]\n";
	close GAME_LOG;
}

sub random_normal {
	my ($avg, $stddev) = @_;
	return $avg + $stddev * sqrt( -2 * log(rand()) ) * cos(2*pi* rand());
}

# Run the bot until it is done.
$poe_kernel->run();
exit 0;