#!/usr/local/bin/perl -w
# ======================================================================
# Evolutionary War Multiplayer
# Version:	1.0
# Modified: 12/12/2002
#
# Peter Lorenzen <lorenzen@cs.unc.edu>
# Wesley Miaw <wesley@cs.unc.edu>
# ======================================================================
# IMPORT LIBRARIES AND MODULES
# ----------------------------------------------------------------------
use 5.008;
use threads;
use threads::shared;
use strict;
use warnings;
use Socket;
use Config;
use Carp;
use Time::HiRes qw(usleep gettimeofday tv_interval);
use Tk;
use Tk::widgets qw(Button Label Menu);
use Tk::Dialog;
use lib '.';
use RPC;
# ======================================================================
# INITIALIZATION
# ----------------------------------------------------------------------
# Verify threading is enabled.
$Config{useithreads} or die "Recompile Perl with threads to run this program.";
#
# Untaint the PATH.
$ENV{PATH} = '/usr/local/bin:/usr/bin:/bin';
# ----------------------------------------------------------------------
# DONE
# ======================================================================
# GLOBAL VARIABLES
# ----------------------------------------------------------------------
# The following variables modify runtime behavior.
use vars qw($localhost $port $timeout $timeout_factor);
#
# $localhost is this host's name.
$localhost	= `hostname`; chomp $localhost;
$localhost =~ /^([A-Za-z0-9_.-]+)$/;
($localhost) = gethostbyname $1;
#
# $port is the server listening port.
$port		= 27025;
#
# $timeout is the time in microseconds between keep-alive messages.
$timeout	= 250_000;
#
# $timeout_factor is the multiplier applied to the timeout before a node
# is considered timed out.
$timeout_factor	= 32;
# ----------------------------------------------------------------------
# The following variables are used by the GUI.
use vars qw($gridCanvas $gridSizeX $gridSizeY $gridSpacing $gridBackgroundColor $gridWidth $gridHeight $rangeMarkLength @rangeMarkList $borderWidth @blobColors %blobArray %currBlobInfo $maxAttributeValue);
#
# $gridCanvas is the Tk canvas used for the game board.
$gridCanvas				= undef;
#
# $gridSizeX and $gridSizeY are the number of columns and rows.
$gridSizeX				= 20;
$gridSizeY				= 20;
#
# $gridSpacing is the pixel size of each grid square.
$gridSpacing			= 20;
#
# $rangeMarkLength is the tick mark length
$rangeMarkLength = 4;
#
# %rangeMarkList is the list of range marks
@rangeMarkList = ();
#
# $gridBackgroundColor is the hex color value of the grid background.
$gridBackgroundColor	= '#303030';
#
# $borderWidth is the pixel size of the grid border.
$borderWidth			= 4;
#
# @blobColors are the various blob Tk color values. The size of this
# array specifies the maximum number of players.
@blobColors				= qw(red green blue yellow purple orange);
#
# $gridWidth and $gridHeight are the grid pixel width and height.
$gridWidth				= $gridSizeX * $gridSpacing + 1;
$gridHeight				= $gridSizeY * $gridSpacing + 1;
#
# %blobArray is the global representation of the game board.
%blobArray = ();
share %blobArray;
#
# Current blob information as displayed in the GUI.
%currBlobInfo = (
	playerId		=> '-',
	strength		=> '-',
	speed			=> '-',
	intelligence	=> '-',
	fertility		=> '-'
);
#
# $maxAttributeValue is the maximum value any characteristic of blob may
# assume.
$maxAttributeValue = 10;
# ----------------------------------------------------------------------
# The following variables are used to represent the system state.
use vars qw($f_server $f_started $f_prompt %last_ping $server %clients %ready $player $player_done $seq_no $selected_x $selected_y $display_lock);
#
# $f_server is true if this process is a server.
$f_server	= 1;
share $f_server;
#
# $f_started is true if the game has started.
$f_started	= 0;
share $f_started;
#
# $f_prompt is true when this process should provide a move to the
# server.
$f_prompt	= 0;
share $f_prompt;
#
# %last_ping is the timestamp of the last received ping, keyed on host.
%last_ping	= ();
share %last_ping;
#
# $server is the server hostname (undef if this process is the server).
$server		= undef;
share $server;
#
# %clients is the hash map of client hostnames to connection timestamps
# (empty if this process is the server).
%clients	= ();
share %clients;
#
# %ready is the hash of client hostnames which are ready to begin play.
%ready		= ();
share %ready;
#
# $player is the hostname of the currently active player.
$player		= undef;
share $player;
#
# $player_done is a condition set by a client when the player has
# completed his move.
$player_done	= undef;
share $player_done;
#
# $seq_no is the current state's sequence number.
$seq_no		= 0;
share $seq_no;
#
# $selected_x and $selected_y if defined contain the x and y position of
# the currently selected blob.
($selected_x, $selected_y) = (undef, undef);
share $selected_x; share $selected_y;
#
# $display_lock is held whenever making Tk calls.
$display_lock	= undef;
share $display_lock;
# ----------------------------------------------------------------------
# DONE
# ======================================================================
# MAIN PROGRAM
# ----------------------------------------------------------------------
# Server or client?
if ($ARGV[0]) {
	print "Client\n";
	$f_server = 0;
	$ARGV[0] =~ /^([A-Za-z0-9_.-]+)$/;
	$server = $1;
	if ($server =~ /^[0-9\.]+$/) {
		my $iaddr = inet_aton($server);
		($server) = gethostbyaddr $iaddr, AF_INET;
	} else {
		($server) = gethostbyname $server;
	}
	croak "Could not resolve $ARGV[0]\n" unless (defined $server);
} else { print "Server\n"; }

# Start the keep-alive and timeout threads.
print "Starting support threads\n";
my $keepalive_thread = threads->new(\&keepalive);
my $timeout_thread = threads->new(\&timeout);
my $server_thread = threads->new(\&server);
my $ready_thread = threads->new(\&broadcast_ready);

# Launch an RPC server.
print "Starting RPC server\n";
my $rpc_thread = threads->new(sub {
	RPC->new_server($localhost, $port);
	RPC->event_loop();
});

# Register myself if server.
if ($f_server) {
	new_client($localhost);
}

# If client, connect to the server.
else {
	print "Connecting to the server\n";

	# Open a server connection.
	my $conn = RPC->connect($server, $port);
	$conn or die "RPC->connect($server, $port) failed";
	
	# Send a new client message.
	my $reply = $conn->rpc('new_client', $localhost);
	$reply or die "$server->rpc(new_client, $localhost) failed";
	ping($server) if ($reply);
}

# Build the GUI.
print "Building GUI\n";
my $mw = &build_gui();
$mw->repeat(500 => \&drawblobs);

# Enter main loop.
print "Starting up\n";
MainLoop();
# ----------------------------------------------------------------------
# DONE
# ======================================================================
# SUBROUTINES
# ----------------------------------------------------------------------
# broadcast_ready sends the ready list to all clients.
sub broadcast_ready {
	while (1) {
		lock %ready;
		cond_wait %ready;
	
		# Fail if this is not the server.
		next unless ($f_server);
	
		# Send the ready list to each client.
		my %local_clients;
		{
			lock %clients;
			%local_clients = %clients;
		}
		foreach my $client (keys %local_clients) {
			# Don't send to myself.
			next if ($client eq $localhost);
			
			# Open a connection to the client.
			my $conn = RPC->connect($client, $port);
			if (!defined $conn) {
				warn "broadcast_ready: RPC->connect($client, $port) failed";
				next;
			}
			
			# Send the ready list.
			eval { $conn->rpc('set_ready', $localhost, %ready); };
			if ($@) { warn "broadcast_ready: $client->rpc(set_ready, $localhost, ...) failed: $@"; }
		}
	}
}
# ----------------------------------------------------------------------
# create_blob tells the server to create a new blob.
#
# $hostname	= the player hostname
# $x		= x position
# $y		= y position
# $id		= player id
# $color	= blob color
# $str		= blob strength
# $spd		= blob speed
# $int		= blob intelligence
# $fer		= blob fertility
sub create_blob {
	# Get arguments.
	my ($hostname, $x, $y, $id, $color, $str, $spd, $int, $fer) = @_;
	
	# If I am not the server, forward this command to the server.
	RETRY: while (!$f_server) {
		# Open a connection to the server.
		my $conn = RPC->connect($server, $port);
		if (!$conn) {
			warn "create_blob: RPC->connect($server, $port) failed";
			usleep($timeout);
			next RETRY;
		}
		
		# Send the command to the server.
		my $reply = undef;
		eval { $reply = $conn->rpc('create_blob', @_); };
		if ($@) {
			warn "create_blob: $server->rpc(create_blob, ...) failed: $@";
			usleep($timeout);
			next RETRY;
		}
		
		# If got here, done.
		return $reply;
	}
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# If I am the server, create the blob if it is from the correct
	# player. Mutate it a little bit.
	return undef unless ($player && $hostname eq $player);
	($str, $spd, $int, $fer) = mutate($str, $spd, $int, $fer);
	AddBlob($x, $y, $id, $color, $str, $spd, $int, $fer);
	
	# Success.
	return 1;
}
# ----------------------------------------------------------------------
# delete_blob tells the server to delete a blob.
#
# $hostname	= the player hostname
# $x		= x position
# $y		= y position
sub delete_blob {
	# Get arguments.
	my ($hostname, $x, $y) = @_;
	
	# If I am not the server, forward this command to the server.
	RETRY: while (!$f_server) {
		# Open a connection to the server.
		my $conn = RPC->connect($server, $port);
		if (!$conn) {
			warn "delete_blob: RPC->connect($server, $port) failed";
			usleep($timeout);
			next RETRY;
		}
		
		# Send the command to the server.
		my $reply = undef;
		eval { $reply = $conn->rpc('delete_blob', @_); };
		if ($@) {
			warn "delete_blob: $server->rpc(delete_blob, ...) failed: $@";
			usleep($timeout);
			next RETRY;
		}
		
		# If got here, done.
		return $reply;
	}
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# If I am the server, create the blob if it is from the correct
	# player. Mutate it a little bit.
	return undef unless ($player && $hostname eq $player);
	DeleteBlob($x, $y);
	
	# Success.
	return 1;
}
# ----------------------------------------------------------------------
# done is called by a player to inform the server it has completed its
# move.
#
# $hostname	= the player hostname
sub done {
	# Get arguments.
	my ($hostname) = @_;
	
	# If I am not the server, forward this command to the server.
	RETRY: while (!$f_server) {
		# Open a connection to the server.
		my $conn = RPC->connect($server, $port);
		if (!$conn) {
			warn "done: RPC->connect($server, $port) failed";
			usleep($timeout);
			next RETRY;
		}
		
		# Send the command to the server.
		my $reply = undef;
		eval { $reply = $conn->rpc('done', @_); };
		if ($@) {
			warn "done: $server->rpc(done, ...) failed: $@";
			usleep($timeout);
			next RETRY;
		}
		
		# If got here, done.
		return $reply;
	}
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# Fail unless the done message is coming from the correct player.
	return undef unless ($player && $hostname eq $player);
	
	# Signal that the blob array has changed.
	lock %blobArray;
	cond_broadcast %blobArray;
	
	# If I am the server, signal that the player is done.
	lock $player_done;
	cond_broadcast $player_done;
	
	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# election compares the submitting host's sequence number to this
# process' sequence number. If this process still has a connection to
# a server, returns undef. Otherwise, returns the sequence number.
#
# $hostname = the submitting hostname
sub election {
	# Get arguments.
	my ($hostname) = @_;
	
	# Fail if the hostname is not defined or empty.
	return undef unless ($hostname);
	ping($hostname);
	
	# Don't reply if the requesting host is not a recognized client.
	return undef unless (exists $clients{$hostname});
	
	# Return the sequence number.
	return seq_no();
}
# ----------------------------------------------------------------------
# initial_stat returns an initial statistic value based on a preset
# distribution.
sub initial_stat {
	my $r = rand 1;
	return 0 if ($r < 0.15);
	return 1 if ($r < 0.60);
	return 2 if ($r < 0.90);
	return 3;
}
# ----------------------------------------------------------------------
# keepalive sends a keep-alive message to either the single server or
# all clients periodically.
sub keepalive {
	# Remember original clients.
	my %current_clients = %clients;
	
	# Create connection contains.
	my %client_conn = ();
	
	while (1) {
		# Sleep for a while.
		usleep($timeout);
		
		# Remove connections which are no longer valid. Either the
		# connection was closed or the client has reinitiated a
		# connection (timestamps are different).
		foreach my $client (keys %current_clients) {
			lock %clients;
			if ((!exists $clients{$client} ||
				 $clients{$client} ne $current_clients{$client}) &&
				exists $client_conn{$client})
			{
				$client_conn{$client}->disconnect();
				delete $client_conn{$client};
			}
		}
			
		# Copy over the new client list.
		{
			lock %clients;
			%current_clients = %clients;
		}
			
		# Open connections for new clients.
		foreach my $client (keys %current_clients) {
			# If this connection is to myself, do nothing.
			next if ($client eq $localhost);
		
			# If this connection is already open do nothing.
			next if (exists $client_conn{$client});
			
			# If this connection does not exist, create one.
			$client_conn{$client} = RPC->connect($client, $port);
			if (!$client_conn{$client}) {
				warn "keepalive: RPC->connect($client, $port) failed";
				delete $client_conn{$client};
			}
		}
		
		# Send keep-alive messages and client list updates to each
		# client. Only the server sends out updated client lists, and
		# only to clients.
		CLIENT: foreach my $client (keys %client_conn) {
			eval { $client_conn{$client}->rpc('ping', $localhost); };
			if ($@) {
				warn "keepalive: $client->rpc(ping, $localhost) failed: $@";
				$client_conn{$client}->disconnect();
				delete $client_conn{$client};
				next CLIENT;
			}
			if ($f_server && $client ne $localhost) {
				eval { $client_conn{$client}->rpc('update_clients', $localhost, %current_clients); };
				if ($@) {
					warn "keepalive: $client->rpc(update_clients, $localhost) failed: $@";
					$client_conn{$client}->disconnect();
					delete $client_conn{$client};
				}
			}
		}
	}
}
# ----------------------------------------------------------------------
# move_blob tells the server to move a blob.
#
# $hostname	= the player hostname
# $old_x	= the old x
# $old_y	= the old y
# $new_x	= the new x
# $new_y	= the new y
sub move_blob {
	# Get arguments.
	my ($hostname, $old_x, $old_y, $new_x, $new_y) = @_;
	
	# If I am not the server, forward this command to the server.
	RETRY: while (!$f_server) {
		# Open a connection to the server.
		my $conn = RPC->connect($server, $port);
		if (!$conn) {
			warn "move_blob: RPC->connect($server, $port) failed";
			usleep($timeout);
			next RETRY;
		}
		
		# Send the command to the server.
		my $reply = undef;
		eval { $reply = $conn->rpc('move_blob', @_); };
		if ($@) {
			warn "move_blob: $server->rpc(move_blob, ...) failed: $@";
			usleep($timeout);
			next RETRY;
		}
		
		# If got here, done.
		return $reply;
	}
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# Fail if the request is not from the active player.
	return undef unless ($player && $hostname eq $player);
	
	# Don't touch anything if the blob is not moving.
	return 1 if ($new_x == $old_x && $new_y == $old_y);
		
	# Move the blob.
	my %blob;
	{
		lock %blobArray;
		$blob{player_id} = $blobArray{"$old_x\_$old_y\_playerId"};
		$blob{color} = $blobArray{"$old_x\_$old_y\_color"};
		$blob{str} = $blobArray{"$old_x\_$old_y\_strength"};
		$blob{spd} = $blobArray{"$old_x\_$old_y\_speed"};
		$blob{int} = $blobArray{"$old_x\_$old_y\_intelligence"};
		$blob{fer} = $blobArray{"$old_x\_$old_y\_fertility"};
	}
	DeleteBlob($old_x, $old_y) or return undef;
	AddBlob($new_x, $new_y, $blob{player_id}, $blob{color}, $blob{str}, $blob{spd}, $blob{int}, $blob{fer}) or return undef;
	
	# Success.
	return 1;
}
# ----------------------------------------------------------------------
# mutate returns slightly mutated values for the given strength, speed,
# intelligence, and fertility based on the fertility value.
#
# $str	= strength
# $spd	= speed
# $int	= intelligence
# $fer	= fertility
sub mutate {
	# Get arguments.
	my ($str, $spd, $int, $fer) = @_;
	
	# Calculate mutation probabilities.
	my $pos_probability = 0.25 + $fer / (4 * $maxAttributeValue);
	my $neg_probability = (1 - $pos_probability) * .25;
	
	# Mutate each attribute.
	my $r = rand 1;
	($r < $pos_probability) ? $str++ :
	($r < $pos_probability + $neg_probability) ? $str-- : 0;
	$r = rand 1;
	($r < $pos_probability) ? $spd++ :
	($r < $pos_probability + $neg_probability) ? $spd-- : 0;
	$r = rand 1;
	($r < $pos_probability) ? $int++ :
	($r < $pos_probability + $neg_probability) ? $int-- : 0;
	$r = rand 1;
	($r < $pos_probability) ? $fer++ :
	($r < $pos_probability + $neg_probability) ? $fer-- : 0;
	
	# Check mutation bounds.
	$str = ($str < 0) ? 0 :
		($str > $maxAttributeValue) ? $maxAttributeValue : $str;
	$spd = ($spd < 0) ? 0 :
		($spd > $maxAttributeValue) ? $maxAttributeValue : $spd;
	$int = ($int < 0) ? 0 :
		($int > $maxAttributeValue) ? $maxAttributeValue : $int;
	$fer = ($fer < 0) ? 0 :
		($fer > $maxAttributeValue) ? $maxAttributeValue : $fer;
	
	# Return the mutated attributes.
	return ($str, $spd, $int, $fer);
}
# ----------------------------------------------------------------------
# ping is called when a host pings this server.
#
# $hostname = the hostname
sub ping {
	# Get arguments.
	my ($hostname) = @_;
	
	# Fail if the hostname is empty.
	return undef if !$hostname;
	
	# Update the last ping timestamps.
	my @tv : shared = gettimeofday();
	lock %last_ping;
	$last_ping{$hostname} = \@tv;
	
	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# prompt is sent from a server to the client to prompt for a player's
# next move. The client is then responsible for returning the new game
# state by making an RPC call to the server's move subroutine.
#
# $hostname	= the server hostname
sub prompt {
	# Get arguments.
	my ($hostname) = @_;
	
	# Fail if the prompting hostname is not the server, and I am also
	# not the server.
	return undef unless ($hostname);
	ping($hostname);
	return undef unless ($f_server || $hostname eq $server);

	# Turn on the prompt flag.
	$f_prompt = 1;
	
	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# new_client adds a host to the list of clients.
#
# $hostname = the new client hostname
sub new_client {
	# Get arguments.
	my ($hostname) = @_;
	
	# Fail if this process is not a server.
	return undef unless ($f_server);
	
	# Don't allow clients to join if already started.
	return undef if ($f_started);
	
	# Don't allow clients to join if already too many players.
	{
		lock %clients;
		return undef if (scalar keys %clients == scalar @blobColors);
	}
	
	# Count this request as a ping.
	print "new_client($hostname)\n";
	ping($hostname);
	
	# Add this hostname to the list of clients.
	lock %clients;
	$clients{$hostname} = join '', gettimeofday();
	
	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# send_player sends the current active player hostname to all clients.
sub send_player {
	# Fail if this is not the server.
	return undef unless ($f_server);

	# Send the state to each client.
	my %local_clients;
	{
		lock %clients;
		%local_clients = %clients;
	}
	foreach my $client (keys %local_clients) {
		# Don't send to myself.
		next if ($client eq $localhost);
		
		# Open a connection to the client.
		my $conn = RPC->connect($client, $port);
		if (!defined $conn) {
			warn "send_state: RPC->connect($client, $port) failed";
			next;
		}
		
		# Send the blob array.
		eval { $conn->rpc('set_player', $localhost, $player); };
		if ($@) { warn "$client->rpc(set_player, $localhost, $player) failed: $@"; }
	}
	
	# Success.
	return 1;
}
# ----------------------------------------------------------------------
# send_start informs the server that this client is ready to begin play.
sub send_start {
	# Figure out who to talk to.
	my $host = ($f_server) ? $localhost : $server;

	# Open a connection to the server.
	my $conn = RPC->connect($host, $port);
	if (!defined $conn) {
		warn "start: RPC->connect($host, $port) failed";
		return undef;
	}
	
	# Send the start game call.
	eval {
		my $reply = $conn->rpc('start_game', $localhost);
		unless ($reply) {
			warn "Server rejected start game RPC";
			return undef;
		}
	};
	if ($@) {
		warn "start: $host->rpc(start_game, $localhost) failed: $@";
		return undef;
	}
	
	# Success.
	return 1;
}
# ----------------------------------------------------------------------
# send_state sends the server's blob array to all clients.
sub send_state {
	# Fail if this is not the server.
	return undef unless ($f_server);

	# Send the state to each client.
	my (%local_clients, %local_blobs);
	{
		lock %clients;
		%local_clients = %clients;
	}
	{
		lock %blobArray;
		%local_blobs = %blobArray;
	}
	foreach my $client (keys %local_clients) {
		# Don't send to myself.
		next if ($client eq $localhost);
		
		# Open a connection to the client.
		my $conn = RPC->connect($client, $port);
		if (!$conn) {
			warn "send_state: RPC->connect($client, $port) failed";
			next;
		}
		
		# Send the blob array.
		eval { $conn->rpc('update_blobs', $localhost, %local_blobs); };
		if ($@) { warn "$client->rpc(update_blobs, $localhost, ...) failed: $@"; }
	}
	
	# Success.
	return 1;
}
# ----------------------------------------------------------------------
# seq_no returns and optionally sets the current state sequence number.
#
# $n	= new sequence number (optional)
sub seq_no {
	($_[0]) ? $seq_no = shift : $seq_no;
}
# ----------------------------------------------------------------------
# server performs all of the server functionality.
sub server {
	WHILE: while (1) {
		# Sleep for a while.
		usleep($timeout);
		
		# If this process is a client, do nothing.
		next WHILE unless ($f_server == 1);
		
		# If the game has not started, check if all clients are ready.
		if (!$f_started) {
			# Check if all clients are ready.
			my $all_ready = 1;
			my $n_clients = 0;
			{
				lock %ready; lock %clients;
				foreach my $client (keys %clients) {
					if (!exists $ready{$client}) {
						$all_ready = 0;
						last;
					}
				}
				$n_clients = scalar keys %clients;
			}
			
			# If all clients are ready, begin the game.
			if ($all_ready && $n_clients > 0) {
				# Calculate the number of blobs allocated per player.
				my $n_blobs = int($gridSizeX * $gridSizeY * 0.15 / $n_clients);
				
				# For each player, place n blobs in adjacent squares.
				my @hostnames;
				{
					lock %clients;
					@hostnames = sort keys %clients;
				}
				for (my $i = 0; $i < $n_clients; $i++) {
					# Set the starting x, y, and color values.
					my $x = int rand $gridSizeX;
					my $y = int rand $gridSizeY;
					my $id = $hostnames[$i];
					my $color = $blobColors[$i];
					
					# Add n blobs.
					for (my $j = 0; $j < $n_blobs; $j++) {
						# Generate some random initial stat values.
						my $str = &initial_stat();
						my $spd = &initial_stat();
						my $int = &initial_stat();
						my $fer = &initial_stat();
						
						# Try to place a blob in a random adjacent location.
						while (1) {
							# Move to a random adjacent location.
							my $r = int rand 4;
							($r == 0) ? $x++ :
							($r == 1) ? $x-- :
							($r == 2) ? $y++ :
							($r == 3) ? $y-- : 0;
							
							# Pick a new x and y if the random adjacent location
							# is out of bounds.
							$x = int rand $gridSizeX if ($x < 0 || $x >= $gridSizeX);
							$y = int rand $gridSizeY if ($y < 0 || $y >= $gridSizeY);
							
							# Attempt to place the blob.
							last if &AddBlob($x, $y, $id, $color, $str, $spd, $int, $fer);
						}
					}
				}
				
				# Officially start the game.
				print "Beginning game\n";
				$f_started = 1;
			}
			
			# Otherwise loop.
			else { next WHILE; }
		}
		
		# At this point, the game has started.
		#
		# Provide the server's declared state to all clients.
		&send_state;
		
		# Start another thread to send out state updates as they occur.
		my $update_thread = threads->new(\&update_state);
		
		# Get the current list of players.
		my @players;
		{
			lock %clients;
			@players = keys %clients;
		}
	
		# Begin the gameplay loop.
		my $player_index = 0;
		PLAYER: while (1) {
			# Choose a player.
			$player_index %= scalar @players;
			$player = $players[$player_index];
			
			# Remove this player if it timed out.
			{
				lock %clients;
				if (!exists $clients{$player}) {
					splice @players, $player_index, 1;
					next PLAYER;
				}
			}
			
			# Inform others of the active player.
			print "Prompting $player\n";
			&send_player($player);
			
			# Attempt to send the prompt unless the player times out.
			PROMPT: while ($player) {
				# Lock player_done so it cannot be changed.
				lock $player_done;
				
				# Open a connection to the player.
				my $conn = RPC->connect($player, $port);
				if (!$conn) {
					warn "server: RPC->connect($player, $port) failed";
					usleep($timeout);
					next PROMPT;
				}
				
				# Send a prompt to the player.
				my $reply = undef;
				eval { $reply = $conn->rpc('prompt', $localhost); };
				if ($@ || !$reply) {
					warn "server: $player->rpc(prompt, $localhost) failed: $@";
					usleep($timeout);
					next PROMPT;
				}
				
				# Wait for the player to finish.
				cond_wait $player_done;
				
				# Move to the next player.
				$player_index++;
				next PLAYER;
			}
			
			# Client timed out. Remove it from the list of players.
			splice @players, $player_index, 1;
		}
 	}
}
# ----------------------------------------------------------------------
# set_player is called by the server to set the active player name.
#
# $hostname	= the server hostname
# $p		= the player hostname
sub set_player {
	# Get arguments.
	my ($hostname, $p) = @_;
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# Fail if not sent from the server or I am the server.
	return undef if ($f_server || $server ne $hostname);
	
	# Set the player.
	print "$p\'s turn\n";
	$player = $p;
	
	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# set_ready is called by the server to set the ready list.
#
# $hostname	= the server hostname
# %ready	= the ready list
sub set_ready {
	# Get arguments.
	my ($hostname) = shift;
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# Set the ready list.
	lock %ready;
	%ready = @_;
	
	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# start_game is called by a client to inform this server that it is
# ready to begin play.
#
# $hostname	= the client hostname
sub start_game {
	# Get arguments.
	my ($hostname) = @_;
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# Fail if not a server.
	return undef unless ($f_server);
	print "start_game($hostname)\n";
	
	# Mark this client as ready to begin.
	{
		lock %ready;
		$ready{$hostname} = 1;
		cond_broadcast %ready;
	}
	
	if (0) {
	# Check if all clients are ready.
	my $all_ready = 1;
	my $n_clients = 0;
	{
		lock %ready; lock %clients;
		foreach my $client (keys %clients) {
			if (!exists $ready{$client}) {
				$all_ready = 0;
				last;
			}
		}
		$n_clients = scalar keys %clients;
	}
	
	# If all clients are ready, begin the game.
	if ($all_ready && $n_clients > 0) {
		# Calculate the number of blobs allocated per player.
		my $n_blobs = int($gridSizeX * $gridSizeY * 0.15 / $n_clients);
		
		# For each player, place n blobs in adjacent squares.
		my @hostnames;
		{
			lock %clients;
			@hostnames = sort keys %clients;
		}
		for (my $i = 0; $i < $n_clients; $i++) {
			# Set the starting x, y, and color values.
			my $x = int rand $gridSizeX;
			my $y = int rand $gridSizeY;
			my $id = $hostnames[$i];
			my $color = $blobColors[$i];
			
			# Add n blobs.
			for (my $j = 0; $j < $n_blobs; $j++) {
				# Generate some random initial stat values.
				my $str = &initial_stat();
				my $spd = &initial_stat();
				my $int = &initial_stat();
				my $fer = &initial_stat();
				
				# Try to place a blob in a random adjacent location.
				while (1) {
					# Move to a random adjacent location.
					my $r = int rand 4;
					($r == 0) ? $x++ :
					($r == 1) ? $x-- :
					($r == 2) ? $y++ :
					($r == 3) ? $y-- : 0;
					
					# Pick a new x and y if the random adjacent location
					# is out of bounds.
					$x = int rand $gridSizeX if ($x < 0 || $x >= $gridSizeX);
					$y = int rand $gridSizeY if ($y < 0 || $y >= $gridSizeY);
					
					# Attempt to place the blob.
					last if &AddBlob($x, $y, $id, $color, $str, $spd, $int, $fer);
				}
			}
		}
		
		# Officially start the game.
		print "Beginning game\n";
		$f_started = 1;
	}
	}

	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# timeout periodically checks the last ping timestamps and initiates a
# server election if the server has timed out, or drops a client if a
# client has timed out.
sub timeout {
	while (1) {
		# Sleep for a while.
		usleep($timeout);
		
		# If this process is a client, check the server timestamp.
		if (!$f_server) {
			# Skip if server has not yet pinged us.
			my $delay = 0;
			{
				lock %last_ping;
				next unless (exists $last_ping{$server});
				$delay = tv_interval($last_ping{$server}) * 1_000_000;
			}
			
			# If the server never sent a ping, or has timed out,
			# initiate a server election.
			if ($delay > $timeout * $timeout_factor) {
				# Forget about the server. It's gone.
				print "$server timed out: ${delay}us\n";
				my $old_server = $server;
				{
					lock %clients;
					delete $clients{$server};
				}
				undef $server;
			
				# For each client that is not me, send an election
				# message.
				my %election_replies = ();
				{
					my %local_clients;
					{
						lock %clients;
						%local_clients = %clients;
					
					}
					print "Sending election messages to ", join(', ', keys %local_clients), "\n";
					foreach my $client (keys %local_clients) {
						# Skip me.
						next if $client eq $localhost;
						
						# Open a connection.
						my $conn = RPC->connect($client, $port);
						if (!defined $conn) {
							warn "timeout: RPC->connect($client, $port) failed";
							next;
						}
						
						# Send election message.
						eval {
							my $reply = $conn->rpc('election', $localhost);
							$election_replies{$client} = $reply if (defined $reply);
						};
						if ($@) { warn "timeout: $client->rpc(election, $localhost) failed: $@"; }
					}
				}
			
				# Choose the best election reply as the new server.
				$server = $localhost;
				my $server_reply = seq_no();
				foreach my $client (sort keys %election_replies) {
					print "Comparing $server($server_reply) to $client($election_replies{$client})\n";
					if ($election_replies{$client} > $server_reply ||
						($election_replies{$client} == $server_reply &&
						 $client lt $server))
					{
						$server = $client;
						$server_reply = $election_replies{$client};
					}
				}
				
				# Check if this process is the new server.
				print "Server is now $server (I am $localhost)\n";
				if ($server eq $localhost) {
					# Set myself as the server.
					$f_server = 1;
					undef $server;
				}
					
				# Delete the old server's blobs.
				{
					lock %blobArray;
					my @blob_keys = grep { $blobArray{$_} eq $old_server } (grep /_playerId/, keys %blobArray);
					foreach my $key (@blob_keys) {
						my ($x, $y) = $key =~ /^([0-9]+)_([0-9]+)_/;
						DeleteBlob($x, $y);
					}
					cond_broadcast %blobArray;
				}
			}
		}
		
		# If this process is the server, check the client timestamps.
		else {
			# Check each client's last received ping time.
			my %local_clients;
			{
				lock %clients;
				%local_clients = %clients;
			}
			foreach my $client (keys %local_clients) {
				# Skip ourself.
				next if ($client eq $localhost);
			
				# Skip clients that have not yet pinged us.
				my $delay = 0;
				{
					lock %last_ping;
					next unless (exists $last_ping{$client});
					$delay = tv_interval($last_ping{$client}) * 1_000_000;
				}
				
				# Check timestamp.
				if ($delay > $timeout * $timeout_factor) {
					print "$client timed out: ${delay}us\n";
					
					# Make sure the prompt continues.
					if ($player && $player eq $client) {
						undef $player;
						lock $player_done;
						cond_broadcast $player_done;
					}
				
					# Drop the client.
					{
						lock %clients; lock %ready;
						delete $clients{$client};
						delete $ready{$client};
					}
					
					# Delete the client's blobs.
					{
						lock %blobArray;
						my @blob_keys = grep { $blobArray{$_} eq $client } (grep /_playerId/, keys %blobArray);
						foreach my $key (@blob_keys) {
							my ($x, $y) = $key =~ /^([0-9]+)_([0-9]+)_/;
							DeleteBlob($x, $y);
						}
						cond_broadcast %blobArray;
					}
				}
			}
		}
	}
}
# ----------------------------------------------------------------------
# update_blobs sets the new blob array value. It also sets the start
# game flag to true.
#
# $hostname	= the server hostname
# @newArray	= the new blob array value
sub update_blobs {
	# Get arguments.
	my ($hostname) = shift;
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# Don't do anything if I am the server.
	return 1 if ($f_server);
	
	# Fail if the message is not from the server.
	return undef unless ($hostname eq $server);
	
	# The game has started.
	$f_started = 1;
	
	# Set the new blob array.
	{
		lock %blobArray;
		%blobArray = @_;
		cond_broadcast %blobArray;
	}
	
	# Increment the sequence number.
	seq_no(seq_no() + 1);
	
	# Success.
	return 1;
}
# ----------------------------------------------------------------------
# update_clients sets the clients list based on the server's correct
# list.
#
# $hostname	= the sending hostname
# %clients	= the correct clients list
sub update_clients {
	# Get arguments.
	my $hostname = shift;
	
	# Fail unless the hostname is defined.
	return undef unless ($hostname).
	ping($hostname);
	
	# Fail if I'm a server or the hostname is invalid.
	return undef if ($f_server || !$hostname);
	
	# Set the client value.
	lock %clients;
	%clients = @_;
	
	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# update_state watches for changes to the blob array and sends out the
# new blob array to all clients.
sub update_state {
	# Fail if not the server.
	return undef unless ($f_server);

	while (1) {
		# Lock and wait on a change to the blob array.
		my %local_blobs;
		{
			lock %blobArray;
			cond_wait %blobArray;
			%local_blobs = %blobArray;
		}
		
		# Send the state to each client.
		my %local_clients;
		{
			lock %clients;
			%local_clients = %clients;
		}
		foreach my $client (keys %local_clients) {
			# Don't send to myself.
			next if ($client eq $localhost);
			
			# Open a connection to the client.
			my $conn = RPC->connect($client, $port);
			if (!defined $conn) {
				warn "update_state: RPC->connect($client, $port) failed";
				next;
			}
			
			# Send the blob array.
			eval { $conn->rpc('update_blobs', $localhost, %local_blobs); };
			if ($@) { warn "update_state: $client->rpc(update_blobs, $localhost, ...) failed: $@"; }
		}
	}
}
# ----------------------------------------------------------------------
# DONE
# ======================================================================
# GUI SUBROUTINES
# ----------------------------------------------------------------------
# build_gui creates the Tk interface to the game. Returns the top level
# window.
sub build_gui {
	lock $display_lock;

	# Create a top level window.
	my $topWin = MainWindow->new();
	$topWin->configure(-title => 'Evolutionary War GUI');

	# Split the top window into left and right frames.
	my $leftFrame = $topWin->Frame->pack(-side => 'left');
	my $rightFrame = $topWin->Frame->pack(-side => 'top');

	# Place the grid panel into the left frame.
	my $gridFrame = $leftFrame->Frame(
		-relief => 'sunken',
		-borderwidth => $borderWidth,
		-bg => $gridBackgroundColor
	)->pack(-padx => 2, -pady => 2);
	
	# Create the grid canvas.
	$gridCanvas = $gridFrame->Canvas(
		-width => $gridWidth,
		-height => $gridHeight,
		-bg => $gridBackgroundColor,
		-highlightthickness => 0
	)->pack;

	# Place the blob panel into the right frame.
	my $blobFrame = $rightFrame->Frame(
		-relief => 'sunken',
		-borderwidth => $borderWidth
	)->pack(-padx => 2, -pady => 2);

	# Add blob information labels
	$blobFrame->Label(
		-text => 'Player:'
	)->grid(-row => 0, -column => 0, -sticky => 'w');
	$blobFrame->Label(
		-textvariable => \$currBlobInfo{playerId},
		-width => 25
	)->grid(-row => 0, -column => 1, -sticky => 'e' );

	$blobFrame->Label(
		-text => 'Strength:'
	)->grid(-row => 1, -column => 0, -sticky => 'w' );
	$blobFrame->Label(
		-textvariable => \$currBlobInfo{strength},
		-width => 25
	)->grid(-row => 1, -column => 1, -sticky => 'e');

	$blobFrame->Label(
		-text => 'Speed:'
	)->grid(-row => 2, -column => 0, -sticky => 'w' );
	$blobFrame->Label(
		-textvariable => \$currBlobInfo{speed},
		-width => 25
	)->grid(-row => 2, -column => 1, -sticky => 'e' );

	$blobFrame->Label(
		-text => 'Intelligence:'
	)->grid(-row => 3, -column => 0, -sticky => 'w');
	$blobFrame->Label(
		-textvariable => \$currBlobInfo{intelligence},
		-width => 25
	)->grid(-row => 3, -column => 1, -sticky => 'e');

	$blobFrame->Label(
		-text => 'Fertility:'
	)->grid( -row => 4, -column => 0, -sticky => 'w' );
	$blobFrame->Label(
		-textvariable => \$currBlobInfo{fertility},
		-width => 25
	)->grid(-row => 4, -column => 1, -sticky => 'e' );

	# Bind commands.
	$topWin->bind('<ButtonPress-1>', [\&click]);
	$topWin->bind('<Motion>', [\&Motion]);
	$topWin->bind('<ButtonPress-2>', [sub { &deselect; }]);

	# Place the menubar.
	&MenuBar($topWin);
	
	# Return the top level window.
	return $topWin;
}
# ----------------------------------------------------------------------
# click is called when a user clicks with the left mouse button.
sub click {
	# Get arguments.
	my $w = shift;
	my $event = $w->XEvent;
	my ($x, $y) = ($event->x, $event->y);
	
	# Fail if the server has not prompted us for a move.
	return undef unless ($f_prompt);
	
	# Calculate the logical grid position.
	$x = int($x / $gridSpacing);
	$y = int($y / $gridSpacing);
	
	# Fail if the logical position is out of bounds.
	return undef if ($x < 0 || $x >= $gridSizeX || $y < 0 || $y >= $gridSizeY);
	
	# If a blob is not already selected, select this one.
	unless (defined $selected_x && defined $selected_y) {
		# Don't do anything if there is no blob here or if the blob
		# belongs to a different player.
		{
			lock %blobArray;
			return undef unless (exists $blobArray{"$x\_$y"} &&
								 $blobArray{"$x\_$y\_playerId"} eq $localhost);
		}
	
		# Select the blob.
		($selected_x, $selected_y) = ($x, $y);
		DrawSelectedBox($selected_x, $selected_y);
		
		# Return success.
		return 1;
	}
	
	# If a blob has been selected, figure out what to do here.
	#
	# Did the user wish to clone this blob?
	if ($x == $selected_x && $y == $selected_y) {
		# Randomly choose an adjacent empty location.
		my $rp = int rand 9;
		my ($ax, $ay) = (undef, undef);
		FOR: for (my $i = 0; $i < 9; $i++) {
			# Set the location to look at.
			my $loc = ($i + $rp) % 9;
			my $loc_column = $loc % 3;
			my $loc_row = int ($loc / 3);
			my $loc_x = ($loc_column == 0) ? $x - 1 :
						($loc_column == 2) ? $x + 1 : $x;
			my $loc_y = ($loc_row == 0) ? $y - 1 :
						($loc_row == 2) ? $y + 1 : $y;
						
			# Skip the center location.
			next if ($loc == 4);
			
			# Fail if this location is occupied or out of bounds.
			{
				lock %blobArray;
				next FOR if (exists $blobArray{"$loc_x\_$loc_y"});
			}
			next if ($loc_x < 0 || $loc_x >= $gridSizeX ||
					 $loc_y < 0 || $loc_y >= $gridSizeY);
			
			# Found an empty in-bounds location.
			($ax, $ay) = ($loc_x, $loc_y);
			last;
		}
		
		# Fail if no empty in-bounds locations were found.
		return undef unless (defined $ax && defined $ay);
		
		# Clone the blob.
		my ($player_id, $color, $str, $spd, $int, $fer);
		{
			lock %blobArray;
			$player_id = $blobArray{"$x\_$y\_playerId"};
			$color = $blobArray{"$x\_$y\_color"};
			$str = $blobArray{"$x\_$y\_strength"};
			$spd = $blobArray{"$x\_$y\_speed"};
			$int = $blobArray{"$x\_$y\_intelligence"};
			$fer = $blobArray{"$x\_$y\_fertility"};
		}
		if (rand 1 <= $blobArray{"$x\_$y\_fertility"} / 10) {
			# Success.
			create_blob(
				$localhost,
				$ax, $ay,
				$player_id, $color,
				$str, $spd, $int, $fer
			) or return undef;
		} else {
			# Failure.
			create_blob(
				$localhost,
				$ax, $ay,
				$player_id, $color,
				0, 0, 0, 0
			) or return undef;
		}
		
		# Unselect the blob.
		deselect();
		
		# Remove prompt.
		$f_prompt = 0;
		
		# Send done.
		done($localhost);
		
		# Return success.
		return 1;
	}
	
	my ($blob_exists, $player_id, $color) = (undef, undef, undef);
	my ($dest_x, $dest_y) = ($selected_x, $selected_y);
	{
		# Does the blob exist, and what is its player id?
		lock %blobArray;
		if (exists $blobArray{"$x\_$y"}) {
			$blob_exists = 1;
			$player_id = $blobArray{"$x\_$y\_playerId"};
			$color = $blobArray{"$x\_$y\_color"};
		}
		
		# Ensure that the clicked location is in a straight line, within
		# the selected blob's speed, and unblocked by other blobs.
		return undef unless ($x == $selected_x || $y == $selected_y);
		if ($x == $selected_x && $y != $selected_y) {
			# Fail if out of range.
			return undef if (abs ($y - $selected_y) > $blobArray{"$selected_x\_$selected_y\_speed"});
	
			# Fail if blocked.
			my ($start_y, $end_y) = ($y > $selected_y)
				? ($selected_y + 1, $y - 1)
				: ($y + 1, $selected_y - 1);
			for (; $start_y <= $end_y; $start_y++) {
				return undef if (exists $blobArray{"$x\_$start_y"});
			}
			
			# Set the destination location.
			$dest_y = ($y > $selected_y) ? $y - 1 : $y + 1;
		} elsif ($y == $selected_y && $x != $selected_x) {
			# Fail if out of range.
			return undef if (abs ($x - $selected_x) > $blobArray{"$selected_x\_$selected_y\_speed"});
	
			# Fail if blocked.
			my ($start_x, $end_x) = ($x > $selected_x)
				? ($selected_x + 1, $x - 1)
				: ($x + 1, $selected_x - 1);
			for (; $start_x <= $end_x; $start_x++) {
				return undef if (exists $blobArray{"$start_x\_$y"});
			}
			
			# Set the destination location.
			$dest_x = ($x > $selected_x) ? $x - 1 : $x + 1;
		}
	}
	
	# Did the user click on another blob?
	if ($blob_exists) {
		# If the user clicked on an opponent's blob, this is an attack.
		if ($player_id ne $localhost) {
			# Calculate the survival chance of each blob.
			my $a_prob = 0.50;
			{
				lock %blobArray;
				my $attacker = ($blobArray{"$selected_x\_$selected_y\_strength"} / $maxAttributeValue) + ($blobArray{"$selected_x\_$selected_y\_intelligence"} / (2 * $maxAttributeValue)) + (0.15 * rand 1);
				my $defender = ($blobArray{"$x\_$y\_strength"} / $maxAttributeValue) + (0.15 * rand 1);
				my $total = $attacker + $defender;
				$a_prob = $attacker / $total;
			}
			
			# If attacker wins, destroy the defender and move the
			# attacker.
			my $r = rand 1;
			if ($r < $a_prob) {
				delete_blob($localhost, $x, $y) or return undef;
				move_blob($localhost, $selected_x, $selected_y, $dest_x, $dest_y) or return undef;
			}
			# Otherwise, destroy the attacker.
			else {
				delete_blob($localhost, $selected_x, $selected_y) or return undef;
			}
			
			# Unselect the blob.
			deselect();
			
			# Remove prompt.
			$f_prompt = 0;
			
			# Send done.
			done($localhost);
			
			# Return success.
			return 1;
		}
		
		# Otherwise this is a mate.
		else {
			# Randomly decide how many children are created.
			my $r = rand 1;
			my $n_children = ($r < 0.25) ? 1 : ($r < 0.50) ? 2 : 3;
			
			# Create the first child.
			my %c1;
			my ($c1x, $c1y) = ($dest_x, $dest_y);
			{
				# Set the first child's information.
				lock %blobArray;
				$c1{player_id} = $player_id;
				$c1{color} = $color;
				$c1{str} = ($n_children == 1)
					? int (($blobArray{"$selected_x\_$selected_y\_strength"} +
					  		$blobArray{"$x\_$y\_strength"}) / 2 + 1)
					: (rand 1 < 0.5)
					? $blobArray{"$selected_x\_$selected_y\_strength"}
					: $blobArray{"$x\_$y\_strength"};
				$c1{spd} = ($n_children == 1)
					? int (($blobArray{"$selected_x\_$selected_y\_speed"} +
					  		$blobArray{"$x\_$y\_speed"}) / 2 + 1)
					: (rand 1 < 0.5)
					? $blobArray{"$selected_x\_$selected_y\_speed"}
					: $blobArray{"$x\_$y\_speed"};
				$c1{int} = ($n_children == 1)
					? int (($blobArray{"$selected_x\_$selected_y\_intelligence"} +
					  		$blobArray{"$x\_$y\_intelligence"}) / 2 + 1)
					: (rand 1 < 0.5)
					? $blobArray{"$selected_x\_$selected_y\_intelligence"}
					: $blobArray{"$x\_$y\_intelligence"};
				$c1{fer} = ($n_children == 1)
					? int (($blobArray{"$selected_x\_$selected_y\_fertility"} +
					  		$blobArray{"$x\_$y\_fertility"}) / 2 + 1)
					: (rand 1 < 0.5)
					? $blobArray{"$selected_x\_$selected_y\_fertility"}
					: $blobArray{"$x\_$y\_fertility"};
			}
			
			# Create the second child.
			my %c2;
			my ($c2x, $c2y) = ($x, $y);
			if ($n_children > 1) {
				{
					# Set the second child's information.
					lock %blobArray;
					$c2{player_id} = $player_id;
					$c2{color} = $color;
					$c2{str} = (rand 1 < 0.5)
						? $blobArray{"$selected_x\_$selected_y\_strength"}
						: $blobArray{"$x\_$y\_strength"};
					$c2{spd} = (rand 1 < 0.5)
						? $blobArray{"$selected_x\_$selected_y\_speed"}
						: $blobArray{"$x\_$y\_speed"};
					$c2{int} = (rand 1 < 0.5)
						? $blobArray{"$selected_x\_$selected_y\_intelligence"}
						: $blobArray{"$x\_$y\_intelligence"};
					$c2{fer} = (rand 1 < 0.5)
						? $blobArray{"$selected_x\_$selected_y\_fertility"}
						: $blobArray{"$x\_$y\_fertility"};
				}
			}
			
			# Place the first child.
			delete_blob($localhost, $selected_x, $selected_y) or return undef;
			create_blob(
				$localhost,
				$c1x, $c1y,
				$c1{player_id}, $c1{color},
				$c1{str}, $c1{spd}, $c1{int}, $c1{fer}
			) or return undef;
			
			# Place the second child.
			if ($n_children == 2) {
				delete_blob($localhost, $x, $y) or return undef;
				create_blob(
					$localhost,
					$c2x, $c2y,
					$c2{player_id}, $c2{color},
					$c2{str}, $c2{spd}, $c2{int}, $c2{fer}
				) or return undef;
			}
			
			# Create the third child.
			if ($n_children == 3) {
				# Randomly choose an adjacent empty location.
				my $rp = int rand 18;
				my ($ax, $ay) = (undef, undef);
				FOR: for (my $i = 0; $i < 18; $i++) {
					# Set the location to look at.
					my $loc = ($i + $rp) % 18;
					my $loc_column = $loc % 3;
					my $loc_row = int ($loc / 3);
					my ($loc_x, $loc_y) = ($loc < 9)
						? ($c1x, $c1y)
						: ($c2x, $c2y);
					($loc_column == 0) ? $loc_x-- :
					($loc_column == 2) ? $loc_x++ : 0;
					($loc_row == 0) ? $loc_y-- :
					($loc_row == 2) ? $loc_y++ : 0;
					
					# Skip the center locations.
					next if ($loc == 4 || $loc == 13);
					
					# Fail if this location is occupied or out of bounds.
					{
						lock %blobArray;
						next FOR if (exists $blobArray{"$loc_x\_$loc_y"} ||
									 ($loc_x == $c1x && $loc_y && $c1y) ||
									 ($loc_x == $c2x && $loc_y && $c2y));
					}
					next if ($loc_x < 0 || $loc_x >= $gridSizeX ||
							 $loc_y < 0 || $loc_y >= $gridSizeY);
					
					# Found an empty in-bounds location.
					($ax, $ay) = ($loc_x, $loc_y);
					last;
				}
				
				# If an empty in-bounds location is found, create a
				# third child.
				if (defined $ax && defined $ay) {
					create_blob(
						$localhost,
						$ax, $ay,
						$c1{player_id},
						$c1{color},
						int (($c1{str} + $c2{str}) / 2),
						int (($c1{spd} + $c2{spd}) / 2),
						int (($c1{int} + $c2{int}) / 2),
						int (($c1{fer} + $c2{fer}) / 2)
					) or return undef;
				}
			}
			
			# Unselect the blob.
			deselect();
			
			# Remove prompt.
			$f_prompt = 0;
			
			# Send done.
			done($localhost);
			
			# Return success.
			return 1;
		}
	} 
	
	# Or on an empty space?
	else {
		# Move the blob.
		move_blob($localhost, $selected_x, $selected_y, $x, $y) or return undef;
		
		# Unselect the blob.
		deselect();
		
		# Remove prompt.
		$f_prompt = 0;
		
		# Send done.
		done($localhost);
		
		# Return success.
		return 1;
	}
}
# ----------------------------------------------------------------------
# deselect deselects any selected blob.
sub deselect {
	lock $display_lock;
	($selected_x, $selected_y) = (undef, undef);
	$gridCanvas->delete("selected");
	map { $gridCanvas->delete($_) } @rangeMarkList;
	@rangeMarkList = ();
}
# ----------------------------------------------------------------------
# drawblobs waits for a change to the blob array and then redraws the
# game board.
sub drawblobs {
	# Lock and wait on a change to the blob array.
	my %local_blobs;
	{
		lock %blobArray;
		%local_blobs = %blobArray;
	}

	# Replace the blob circles.
	for(my $xPos = 0; $xPos < $gridSizeX; $xPos++) {
		for(my $yPos = 0; $yPos < $gridSizeY; $yPos++) {
			# If a blob exists here, draw it.
			if (exists $local_blobs{"$xPos\_$yPos"}) {
				# Scale the size of the blob by its fitness.
				my $fitness_scale = (1 - $local_blobs{"$xPos\_$yPos\_fitness"}) / 2;

				# Verify the blob color.
				my $color = $local_blobs{"$xPos\_$yPos\_color"};
				unless (grep { $_ eq $color } @blobColors) {
					croak "Received invalid color $color";
				}
				
				# Calculate the blob pixel positions.
				my $upperLeftX = int(($xPos * $gridSpacing) + ($maxAttributeValue * $fitness_scale) + 1.5);
				my $upperLeftY = int(($yPos * $gridSpacing) + ($maxAttributeValue * $fitness_scale) + 1.5);
				my $lowerRightX = int((($xPos + 1) * $gridSpacing) - ($maxAttributeValue * $fitness_scale) - 1);
				my $lowerRightY = int((($yPos + 1) * $gridSpacing) - ($maxAttributeValue * $fitness_scale) - 1);

				# Draw the blob.
				lock $display_lock;
				$gridCanvas->delete("blob-$xPos-$yPos");
				$gridCanvas->createOval(
							$upperLeftX, $upperLeftY,
							$lowerRightX, $lowerRightY,
							"-fill", "$color",
							"-tags", ["blob-$xPos-$yPos"]
				);
			}
			
			# Otherwise delete any blob that might be here.
			else {
				lock $display_lock;
				$gridCanvas->delete("blob-$xPos-$yPos");
			}
		}
	}
}
# ----------------------------------------------------------------------
sub DrawRangeMarks {
    my( $xPos, $yPos, $color ) = @_;

    my $upperLeftX = $xPos * $gridSpacing;
    my $upperLeftY = $yPos * $gridSpacing;
    my $lowerRightX = ($xPos + 1) * $gridSpacing;
    my $lowerRightY = ($yPos + 1) * $gridSpacing;

	lock $display_lock;

    # Upper Left
    $gridCanvas->createLine($upperLeftX + $rangeMarkLength, $upperLeftY,
			    $upperLeftX, $upperLeftY,
			    $upperLeftX, $upperLeftY + $rangeMarkLength,
			    "-fill", $color,
			    "-tags", ["rm_ul-$xPos-$yPos"]);
    push @rangeMarkList, "rm_ul-$xPos-$yPos";

    # Upper Right
    $gridCanvas->createLine($lowerRightX - $rangeMarkLength, $upperLeftY,
			    $lowerRightX, $upperLeftY,
			    $lowerRightX, $upperLeftY + $rangeMarkLength,
			    "-fill", $color,
			    "-tags", ["rm_ur-$xPos-$yPos"]);
    push @rangeMarkList, "rm_ur-$xPos-$yPos";

    # Lower Right
    $gridCanvas->createLine($lowerRightX - $rangeMarkLength, $lowerRightY,
			    $lowerRightX, $lowerRightY,
			    $lowerRightX, $lowerRightY - $rangeMarkLength,
			    "-fill", $color,
			    "-tags", ["rm_lr-$xPos-$yPos"]);
    push @rangeMarkList, "rm_lr-$xPos-$yPos";

    # Lower Left
    $gridCanvas->createLine($upperLeftX + $rangeMarkLength, $lowerRightY,
			    $upperLeftX, $lowerRightY,
			    $upperLeftX, $lowerRightY - $rangeMarkLength,
			    "-fill", $color,
			    "-tags", ["rm_ll-$xPos-$yPos"]);
    push @rangeMarkList, "rm_ll-$xPos-$yPos";
}
# ----------------------------------------------------------------------
sub DrawRangeMarksSet {
	my( $xPos, $yPos, $range ) = @_;
	
	# Don't draw things unless it is my turn.
	return undef unless ($f_prompt);
	
	# Don't draw things if something is currently selected.
	return undef if (defined $selected_x && defined $selected_y);

	# Delete any previous range marks
	{
		lock $display_lock;
		map { $gridCanvas->delete($_) } @rangeMarkList;
		@rangeMarkList = ();
	}

	# Central box
	DrawRangeMarks( $xPos, $yPos, "yellow" );

	# X-Direction (Right to Left)
	my $startPos = $xPos - 1;
	my $stopPos = $xPos - $range;
	if( $startPos < 0 ) {
		$startPos = 0;
	}
	if( $stopPos < 0 ) {
		$stopPos = 0;
	}
	for( my $lcv = $startPos; $lcv >= $stopPos; $lcv-- ) {
		DrawRangeMarks( $lcv, $yPos, "yellow" );
		if (exists $blobArray{"$lcv\_$yPos"}) {
			last;
		}
	}

	# X-Direction (Left to Right)
	$startPos = $xPos + 1;
	$stopPos = $xPos + $range;
	if( $startPos >= $gridSizeX ) {
		$startPos = $gridSizeX - 1;
	}
	if( $stopPos >= $gridSizeX ) {
		$stopPos = $gridSizeX - 1;
	}
	for( my $lcv = $startPos; $lcv <= $stopPos; $lcv++ ) {
		DrawRangeMarks( $lcv, $yPos, "yellow" );
		if (exists $blobArray{"$lcv\_$yPos"}) {
			last;
		}
	}

	# Y-Direction (Bottom to Top)
	$startPos = $yPos - 1;
	$stopPos = $yPos - $range;
	if( $startPos < 0 ) {
		$startPos = 0;
	}
	if( $stopPos < 0 ) {
		$stopPos = 0;
	}
	for( my $lcv = $startPos; $lcv >= $stopPos; $lcv-- ) {
		DrawRangeMarks( $xPos, $lcv, "yellow" );
		if (exists $blobArray{"$xPos\_$lcv"}) {
			last;
		}
	}

	# Y-Direction (Top to Bottom)
	$startPos = $yPos + 1;
	$stopPos = $yPos + $range;
	if( $startPos >= $gridSizeY ) {
		$startPos = $gridSizeY - 1;
	}
	if( $stopPos >= $gridSizeY ) {
		$stopPos = $gridSizeY - 1;
	}
	for( my $lcv = $startPos; $lcv <= $stopPos; $lcv++ ) {
		DrawRangeMarks( $xPos, $lcv, "yellow" );
		if (exists $blobArray{"$xPos\_$lcv"}) {
			last;
		}
	}
}
# ----------------------------------------------------------------------
sub DrawSelectedBox {
   my( $xPos, $yPos ) = @_;

    my $upperLeftX = $xPos * $gridSpacing;
    my $upperLeftY = $yPos * $gridSpacing;
    my $lowerRightX = ($xPos + 1) * $gridSpacing;
    my $lowerRightY = ($yPos + 1) * $gridSpacing;
    
    lock $display_lock;

    $gridCanvas->createLine($upperLeftX, $upperLeftY,
			    $lowerRightX, $upperLeftY,
			    $lowerRightX, $lowerRightY,
			    $upperLeftX, $lowerRightY,
			    $upperLeftX, $upperLeftY,
			    "-fill", "white",
			    "-tags", ["selected"]);
}
# ----------------------------------------------------------------------
sub MenuBar {
	lock $display_lock;

	my $top	 = shift;
	my $menu = $top->Menubar;
	
	# File Menu
	my $file = $menu->Menubutton(
		-text => 'File',
		-underline => 0,
		-tearoff => 0
	);
	$file->command(
		-label => 'Start Game',
		-command => \&send_start,
		-underline => 0
	);
	$file->separator;
	$file->command(
		-label => 'Quit',
		-command => sub { $top->destroy },
		-underline => 0
	);

	# Help Menu
	$menu->cascade(
		-label => 'Help',
		-underline => 0,
		-menuitems => [[
			Command => '~Versions',
			-command => [\&ShowVersion, $top ]
		]]
	);

	return $menu
}
# ----------------------------------------------------------------------
sub ShowVersion {
	lock $display_lock;

	my ($top) = @_;
	my $d = $top->Dialog(
		-title => 'Versions',
		-popover => $top,
		-fg	 => '#800000',
		-text => "Evolutionary War : Version 1.0\nWesley Miaw\nPeter Lorenzen",
		-justify => 'left'
	)->Show;
}
# ----------------------------------------------------------------------
sub Motion {
	my $w = shift;
	my $xEvent = $w->XEvent;
	my $xPos = $xEvent->x;
	my $yPos = $xEvent->y;
	
	# Identify logical position
	my $xLogicalPos = int($xPos / $gridSpacing);
	my $yLogicalPos = int($yPos / $gridSpacing);

	PrintBlob($xLogicalPos, $yLogicalPos);
	
	&drawblobs;
}
# ----------------------------------------------------------------------
sub PrintBlob {
	my( $xPos, $yPos ) = @_;

	my %local_blobs;
	{
		lock %blobArray;
		%local_blobs = %blobArray;
	}
	if (exists $local_blobs{"$xPos\_$yPos"}) {
	    # Update current blob information.
	    {
	    	lock $display_lock;
			$currBlobInfo{playerId} = $local_blobs{"$xPos\_$yPos\_playerId"};
			$currBlobInfo{strength} = $local_blobs{"$xPos\_$yPos\_strength"};
			$currBlobInfo{speed} = $local_blobs{"$xPos\_$yPos\_speed"};
			$currBlobInfo{intelligence} = $local_blobs{"$xPos\_$yPos\_intelligence"};
			$currBlobInfo{fertility} = $local_blobs{"$xPos\_$yPos\_fertility"};
		}
		
		# Draw the hash marks.
		&DrawRangeMarksSet($xPos, $yPos, $local_blobs{"$xPos\_$yPos\_speed"});
	}
	else {
		if (!defined $selected_x && !defined $selected_y) {
			# Delete any previous range marks
			lock $display_lock;
			map { $gridCanvas->delete($_) } @rangeMarkList;
			@rangeMarkList = ();
		}
	
		{
			lock $display_lock;
			$currBlobInfo{playerId} = '-';
			$currBlobInfo{strength} = '-';
			$currBlobInfo{speed} = '-';
			$currBlobInfo{intelligence} = '-';
			$currBlobInfo{fertility} = '-';
		}
	}
}
# ----------------------------------------------------------------------
sub AddBlob {
	my( $xPos, $yPos, $playerId, $color, $strength, $speed, $intelligence, $fertility ) = @_;

	# Bounds Checking
	if( $xPos < 0 || $xPos >= $gridSizeX ||
		$yPos < 0 || $yPos >= $gridSizeY )
	{
		carp "[AddBlob] error: out of bounds on xPos: $xPos, yPos: $yPos";
		return undef;
	}
	
	# Fail if a blob already exists there.
	lock %blobArray;
	return undef if (exists $blobArray{"$xPos\_$yPos"});

	# Add blob to array of blobs
	$blobArray{"$xPos\_$yPos"} = 1;
	$blobArray{"$xPos\_$yPos\_playerId"} = $playerId;
	$blobArray{"$xPos\_$yPos\_color"} = $color;
	$blobArray{"$xPos\_$yPos\_tag"} = "blob-$xPos-$yPos";
	$blobArray{"$xPos\_$yPos\_strength"} = $strength;
	$blobArray{"$xPos\_$yPos\_speed"} = $speed;
	$blobArray{"$xPos\_$yPos\_intelligence"} = $intelligence;
	$blobArray{"$xPos\_$yPos\_fertility"} = $fertility;
	$blobArray{"$xPos\_$yPos\_fitness"} = ($strength + $speed + $intelligence + $fertility) / ($maxAttributeValue * 4);

	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
sub DeleteBlob {
	my( $xPos, $yPos ) = @_;

	# Bounds Checking
	if( $xPos < 0 || $xPos >= $gridSizeX ||
		$yPos < 0 || $yPos >= $gridSizeY )
	{
		carp "[DeleteBlob] error: out of bounds on xPos: $xPos, yPos: $yPos";
		return undef;
	}
	
	# Fail if no blob exists there.
	lock %blobArray;
	return undef unless (exists $blobArray{"$xPos\_$yPos"});
	
	# Remove blob from array of blobs
	map { delete $blobArray{$_} } (grep /^${xPos}_${yPos}_/, keys %blobArray);
	delete $blobArray{"$xPos\_$yPos"};
	
	# Return success.
	return 1;
}
# ----------------------------------------------------------------------
# DONE
# ======================================================================
__END__