#!/usr/bin/perl -w

use strict;
use Socket;

# My info
my $robotid;
my $maxweight;
my $money;
my $myx = 1;
my $myy = 1;
my $mypackages;
my $startxy; # => @ X, Y

# Board info
my $boardrows;
my $boardcols;
my @board; #rows => @cols
my @home;

my @robots; #[num] => @ X, Y, number, @packages
my $myrobot; # => $robots[$robotid]

#my %packages;
my @package; # => @ X, Y, weight, pkgnumber
my @packageshere; # Packages at the current location

# Active route
my @route;
my $routetox;
my $routetoy;
my @destination;
my $findanyhome = 0;


sub main(@);
sub opensocket(@);
sub getboard();
sub getconfig();
sub getplayers();
sub getresponse();
sub getpackageinfo();
sub getpackages();
sub readln();
sub printboard();
sub play($);
sub dumproute(@);
sub stringxy($);
sub newrouteto($);
sub routefrom($$);
sub moveto($);
sub dostuff();
sub candrop();
sub selecthome();
sub ishere($);
sub crowflies($;$);
sub adjecent($$);
sub matchxy($$);
sub trimroute(@);

if ($#ARGV != 1) {
	die "Usage: $0 <host> <port>\n";
}

main(@ARGV);
exit;

sub main(@) {

	opensocket(@_);
	play("Player");
	getboard;
	getconfig;
	getresponse;
	$myrobot = $robots[$robotid];

	while (1) {
		getpackageinfo;
		dostuff;
		getresponse;
	}

	#printboard;
}

sub dostuff() {
	my $droplist;
	if (@route && ishere($route[0])) {
print STDERR "Dostuff got here  ";
		shift @route;
	}
	# Decide lots of things
	if (($droplist = candrop) ne "") {
		play("6 Drop $droplist");
	} elsif (@packageshere && !@$mypackages) {
print STDERR "Dostuff: Getting packages  ";
		getpackages;
	} else {
	    if (@$mypackages) {
print STDERR "Dostuff: We have packages ".join(' ',@$mypackages)."  ";
		# We must deliver something
		# Have we already got a route?
		if (!@route) {
			my $pref = $package[$mypackages->[0]];
			$findanyhome = 0;
			@route = newrouteto($pref);
		}
	    } else {
print STDERR "Dostuff: Find packages  ";
		# Find packages
		# Have we already got a route?
		if (!@route) {
			$findanyhome = 1;
			# No packages at this home
			if ($board[$myy][$myx] eq "@") {
				$board[$myy][$myx] = "H";
			}
			@route = newrouteto(selecthome());
			if (!@route) {
				print STDERR "Help out of homes to go to\n";
			}
		}
	    }
	    print STDERR "aiming for ($routetox,$routetoy)  ";
	    if (!moveto($route[0])) {
		# Bumped?
		@route = newrouteto([$routetox, $routetoy]);
		if (!moveto($route[0])) {
			# Punt
			play "1 Drop 1234";
		}
	    }
	}
# print STDERR "End Dostuff\n";
}

sub selecthome() {
	my $home;
	my @sortedhome = sort { crowflies($a) <=> crowflies($b)} @home;
	my $loopcount = 0;
AGAIN:
	$loopcount++;
	foreach $home (@sortedhome) {
print STDERR "Checking ($home->[0],$home->[1]) vs ($myx,$myy)\n";
		if (!matchxy($home, [$myx,$myy])
		 && ($board[$home->[1]][$home->[0]] eq "@") ) {
			return $home;
		}
	}
	# Oops, nowhere to go
	# Reinstate the H's and try again
	foreach $home (@home) {
		 $board[$home->[1]][$home->[0]] = '@'; 
	}
	goto AGAIN if $loopcount < 3;
	# Well? Let's head back to our starting point!!
	return $startxy;
}

# Is this reference to X,Y our current location?
sub ishere($) {
	return ($_[0][0] == $myx) && ($_[0][1] == $myy);
}

sub candrop() {
	my @droplist;
	my $package;
	foreach $package (@$mypackages) {
		print STDERR "Candrop $package[$package][3] at ".stringxy($package[$package]).", we are at $myx, $myy\n";
		if (($package[$package][0] == $myx) && ($package[$package][1] == $myy)) {
			push @droplist, $package; 
		}
	}
	my $result = join ' ', @droplist;
	print STDERR "Returning $result\n";
	return $result;
}



sub getboard() {
	my ($row, $col);
	print STDERR "Getboard\n";
	$_ = readln;
	($boardcols, $boardrows) = split;
	push @board, [ split //, '#' x ($boardcols + 2) ];
	foreach $row (1..$boardrows) {
		$_ = readln;
		my @row = ('#', split(//), '#');
		push @board, \@row;
		foreach $col (1..$boardcols) {
			if ($board[$row][$col] eq "@") {
				push @home, [ $col, $row ];
			}
		}
	}
	push @board, [ split //, '#' x ($boardcols + 2) ];
}

sub getconfig() {
	print STDERR "Getconfig\n";
	$_ = readln;
	($robotid, $maxweight, $money) = split;
}

sub getresponse() {
	my @newrobots;
	my $robotnumber;
	my $robot;
	my %robot;
	$_ = readln;
	my @item = split;
	while ($#item >= 0) {
		$robotnumber = shift @item;
		if ( $robotnumber !~ /^#/ ) {
			print STDERR "$_\n";
			while (1) {
				print STDERR readln."\n";
			}
			exit;
		}
		$robotnumber =~ s/#//;
		unless ($newrobots[$robotnumber] = $robots[$robotnumber]) {
			$newrobots[$robotnumber] = [ 1, 1, $robotnumber, [] ];
		}
		$robot = $newrobots[$robotnumber];
		while ($#item >= 0) {
			last if $item[0] =~ /^#/;
			$_ = shift @item;
			SWITCH: {
			    /N/ && do {
				$robot->[1]++;
				last SWITCH;
			    };
			    /S/ && do {
				$robot->[1]--;
				last SWITCH;
			    };
			    /E/ && do {
				$robot->[0]++;
				last SWITCH;
			    };
			    /W/ && do {
				$robot->[0]--;
				last SWITCH;
			    };
			    /P/ && do {
				push @{$robot->[3]}, shift @item;
				last SWITCH;
			    };
			    /D/ && do {
				dropped($robot, shift @item);
				last SWITCH;
			    };
			    /X/ && do {
				my $x = shift @item;
				shift @item;
				my $y = shift @item;
				$robot->[0] = $x;
				$robot->[1] = $y;
				last SWITCH;
			    };
			}
			print STDERR "Robot $robotnumber is at ".stringxy($robot)."  ";
			if ($robotnumber == $robotid) {
				$myx = $robot->[0];
				$myy = $robot->[1];
				$startxy = [ $myx, $myy ] if !defined $startxy;
				$mypackages = $robot->[3];
			}
		}
	}
	print STDERR "\n";
	@robots = @newrobots;
}

sub getpackageinfo() {
	undef @packageshere;
	$_ = readln;
	my @info = split;
	while (@info) {
		my $num = shift @info;
		if ($num =~ /Robot/) {
			print STDERR "$_\n";
			while (1) {
				print STDERR readln."\n";
			}
			exit;
		}
		$package[$num] = [
			shift @info,
			shift @info,
			shift @info,
			$num
		];
		push @packageshere, $package[$num];
	}
}

sub getpackages() {
	my @packages = sort { crowflies($a) <=> crowflies($b)} @packageshere;
	my $package;
	my @topick;
	for $package (@packages) {
		push @topick, $package->[3];
	}
	play "10 Pick ".join(' ',@topick);
}

sub crowflies($;$) {
	my ($p1, $p2) = @_;
	$p2 = [$myx,$myy] if !defined $p2;
	return abs($p1->[0] - $p2->[0]) + abs($p1->[1] - $p2->[1]);
}

sub moveto($) {
	my $tox = $_[0][0];
	my $toy = $_[0][1];

print STDERR "Moveto ($myx,$myy) => ($tox,$toy)\n";
	my $move;

	# Have we been bumped?
	if (!adjecent $_[0], [$myx, $myy]) {
		print STDERR "Bumped!\n";
		return 0;
	}

	if ($tox > $myx) { $move = "E"; }
	elsif ($tox < $myx) { $move = "W"; }
	elsif ($toy > $myy) { $move = "N"; }
	elsif ($toy < $myy) { $move = "S"; }

	play("1 Move $move");
	return 1;
}


# Drop a packages from a robot's list
sub dropped($$) {
	my $robot = shift;
	my $package = shift;
	my @newlist;
	my $p;
	foreach $p (@{$robot->[3]}) {
		push (@newlist, $p) if $p != $package;
	}
	$robot->[3] = \@newlist;
}

sub matchxy($$) {
	my ($p1, $p2) = @_;
print STDERR "Matching ".stringxy($p1). " and ".stringxy($p2)."\n";
	return ($p1->[0] == $p2->[0]) && ($p1->[1] == $p2->[1]);
}
		
sub adjecent($$) {
	my ($p1, $p2) = @_;
	return
		(($p1->[0] == $p2->[0]) && (abs($p1->[1] - $p2->[1]) == 1))
		|| (($p1->[1] == $p2->[1]) && (abs($p1->[0] - $p2->[0]) == 1));
}

my @rboard;
my @newroutefrom;
# All possible routes to a place
my @routes; # => @ @route
sub newrouteto($) {
	$routetox = $_[0][0];
	$routetoy = $_[0][1];
print STDERR "Newroute to ($routetox,$routetoy)\n";
	undef @newroutefrom;
	undef @routes;
	@rboard = initboard();
	my @route;
print STDERR "Calling routefrom $myx, $myy\n";
	routefrom($myx, $myy);
	@routes = sort { @$a <=> @$b } @routes;
	@route = @{shift @routes};
	shift @route;
	dumproute(@route);
	return @route;
}

sub initboard(@) {
	my @route = @_;
	my @rboard;
	my ($row, $xy);
	my @initialrow = split //, "0" x $boardcols;
	for $row (1..$boardrows) {
		my @row = @initialrow;
		$rboard[$row] = \@row;
	}
	while ($xy = shift @route) {
		$rboard[$xy->[1]][$xy->[0]+1] = 1;
	}
	return @rboard;
}

sub trimroute(@) {
	my @route = @_;
	my $index = 0;
	print STDERR "Trimming from ".scalar @route." to ";
	while ($index < $#route) {
		my $xy = $route[$index];
		my $i;
		for ($i=$#route; $i>$index+1; $i--) {
			if (adjecent($xy, $route[$i])) {
				@route = @route[0..$index,$i..$#route];
				last;
			}
		}
		$index++;
	}
	print STDERR scalar @route."\n";
	return @route;
}

# Grr, can't get this working
#sub trimroute($@) {
#	my ($xy, $myxy, @route) = @_;
#	return undef if (!defined $myxy);
#print STDERR "\nTrim ".stringxy($xy).", ".stringxy($myxy).", ";
#dumproute(@route);
#	my @newroute = trimroute($xy, @route);
#	if (!@newroute) {
#		if (adjecent($xy, $myxy)) {
#			@newroute = ($myxy, trimroute($myxy,@route));
#		}
#	}
#	return @newroute;
#}

# Leaves the result in the global @newroutefrom to save copying in args
sub routefrom($$) {
	my ($fromx, $fromy) = @_;
	my $ground = $board[$fromy][$fromx];
	#print STDERR "Route ($fromx, $fromy) => ($routetox, $routetoy)\n";

	# Are we in a bad spot?
	return 0 if $ground eq "#" || $ground eq "~";
	# Have we been here already?
	return 0 if $rboard[$fromy][$fromx+1];

	push @newroutefrom, [ $fromx, $fromy ];

	# Arrived?
	if ($fromx == $routetox && $fromy == $routetoy) {
		# Store this route and pretend that we have failed
		print STDERR "Found a route ";
		push @routes, [ trimroute @newroutefrom ];
		return 0;
	}

	# Found a home?
	#return 1 if $findanyhome && ($ground eq "@");
	# Found a package?
	#FIXME

	$rboard[$fromy][$fromx+1] = 1;

	my $result;
	# Try to head in the correct direction
	if (abs($fromx-$routetox) > abs($fromy-$routetoy)) {
		if ($fromx > $routetox) {
			if ($fromy > $routetoy) {
				$result = routefrom($fromx-1, $fromy)
					|| routefrom($fromx, $fromy-1)
					|| routefrom($fromx, $fromy+1)
					|| routefrom($fromx+1, $fromy);
			} else {
				$result = routefrom($fromx-1, $fromy)
					|| routefrom($fromx, $fromy+1)
					|| routefrom($fromx, $fromy-1)
					|| routefrom($fromx+1, $fromy);
			}
		} else {
			if ($fromy > $routetoy) {
				$result = routefrom($fromx+1, $fromy)
					|| routefrom($fromx, $fromy-1)
					|| routefrom($fromx, $fromy+1)
					|| routefrom($fromx-1, $fromy);
			} else {
				$result = routefrom($fromx+1, $fromy)
					|| routefrom($fromx, $fromy+1)
					|| routefrom($fromx, $fromy-1)
					|| routefrom($fromx-1, $fromy);
			}
		}
	} else {
		if ($fromy > $routetoy) {
			if ($fromx > $routetox) {
				$result = routefrom($fromx, $fromy-1)
					|| routefrom($fromx-1, $fromy)
					|| routefrom($fromx+1, $fromy)
					|| routefrom($fromx, $fromy+1);
			} else {
				$result = routefrom($fromx, $fromy-1)
					|| routefrom($fromx+1, $fromy)
					|| routefrom($fromx-1, $fromy)
					|| routefrom($fromx, $fromy+1);
			}
		} else {
			if ($fromx > $routetox) {
				$result = routefrom($fromx, $fromy+1)
					|| routefrom($fromx-1, $fromy)
					|| routefrom($fromx+1, $fromy)
					|| routefrom($fromx, $fromy-1);
			} else {
				$result = routefrom($fromx, $fromy+1)
					|| routefrom($fromx+1, $fromy)
					|| routefrom($fromx-1, $fromy)
					|| routefrom($fromx, $fromy-1);
			}
		}
	}

	pop @newroutefrom if ! $result;

	return $result;

}


sub dumproute(@) {
	my @route = @_;
	my $i;
	print STDERR scalar @route." ";
	for $i (0..$#route) {
		print STDERR stringxy $route[$i];
	}
	print STDERR scalar @route."\n";
}

sub stringxy($) {
	return "($_[0][0],$_[0][1])";
}

sub printboard() {
	my ($i, $j);
	for $i (0..($boardrows+1)) {
		print STDERR "$i: ";
		for $j (0..($boardcols+1)) {
			print STDERR $board[$i][$j];
		}
		print STDERR "\n";
	}
}

sub readln() {
    my $line = <SOCK>;
    exit if !defined $line;
    print STDERR "Read: $line";
    chomp $line;
    return $line;
}

sub play($) {
    print STDERR "Send: $_[0]\n";
    print SOCK "$_[0]\n";
}

sub opensocket(@) {
    my ($remote,$port, $iaddr, $paddr, $proto, $line);
    $remote = shift;
    $port = shift;
    $iaddr   = inet_aton($remote)               || die "no host: $remote";
    $paddr   = sockaddr_in($port, $iaddr);
    $proto   = getprotobyname('tcp');
    socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
    connect(SOCK, $paddr)    || die "connect: $!";
    select SOCK;
    $|=1;
    select STDOUT;
}
