#!/usr/bin/perl
#
# As time is limited, and its for the ICFP, I am not going to use OOness.
#
use warnings;
use strict;
use IO::Socket::INET;

our $debug = 0;
our (@map, @nearestmap, $width, $height, $carrying, $fuel, %me, %others, %packages, %mypackages, %droppedpackages, $do, $priority, @items, @posmap, @route, %route,
     $goingtoX,$goingtoY, %punder, $goal, @newpoints, $vert, $hoz);
die "Usage - runme IPADDRESS PORT\n" if (!$ARGV[0] && !$ARGV[1]);

$carrying = 0;
srand(time() ^ ($$ + ($$ <<15)));

#Lets try to connect now
our $socket = IO::Socket::INET->new(
				    'PeerAddr' => $ARGV[0],
				    'PeerPort' => $ARGV[1],
				    'Timeout'  => 5,
				    );
print "Connected to: $ARGV[0]:$ARGV[1]\n" if ($debug && $socket);
die "Can't connect\n" if !$socket;


#Now lets say hello
logOn();
#Lets get the map
getMap();
#Now lets get the other info
getInfo();
#Lets see where everyone is
updateInfo();
#Lets calculate where we can get to on the map
findSpace();
while ($socket) {
    #Now lets get packages
    getPackages();
    #Clever algorithm
    compute();
    #send the command
    sendCmd();
    #update where everyone is
    updateInfo();
}
die "We got kicked off/died, oh well there is always next time\n";

sub logOn {
    print $socket "Player\n";
}

sub getMap {
    ($width,$height) = split / /, readinfo($socket);
    my @maptemp;
    push @maptemp, scalar(readinfo($socket)) while (@maptemp < ($height));
    chomp @maptemp;
    my $line;
    foreach my $y (1..($height)) {
	foreach my $x (1..($width)) {
	    $map[$x][$y] = substr($maptemp[$y - 1],0,1,'');
	}
    }
    @nearestmap = @{copymap(\@map)};
}
sub getInfo {
    ($me{'ID'}, $me{'Strength'}, $fuel) = split / /, readinfo($socket);
}

sub copymap {
    my @array = @{shift()};
    my @other;
    foreach my $y (1..($height)) {
        foreach my $x (1..($width)) {
            $other[$x][$y] = $array[$x][$y];
        }
    }
    return \@other;
}

sub updateInfo {
    my %oldothers = %others;
    undef %others;
    my @info = split /\#/, readinfo($socket);
    chomp @info;
    shift @info;
    foreach my $line (@info) {
	my @data = split / /, $line;
	my $id = shift @data;
	$others{$id} = $oldothers{$id} if $oldothers{$id};
	my $cmd;
	while ($cmd = shift @data) {
	    if ($cmd eq 'N') {
		$others{$id}->{'Y'}++;
	    }elsif ($cmd eq 'S') {
		$others{$id}->{'Y'}--;
	    }elsif ($cmd eq 'E') {
                $others{$id}->{'X'}++;
	    }elsif ($cmd eq 'W') {
                $others{$id}->{'X'}--;
	    }elsif ($cmd eq 'P') {
		my $pkgid = shift @data;
		if ($id == $me{'ID'}) {
		    #add to the package list
		    $carrying += $packages{$pkgid}->{'Weight'};
		    $mypackages{$pkgid} = 1
		}else {
		    #if this is on our list delete it
		    delete $droppedpackages{$pkgid};
		}
            }elsif ($cmd eq 'D') {
                my $pkgid = shift @data;
		if ($id == $me{'ID'}) {
		    #take off the package list
		    $carrying -= $packages{$pkgid}->{'Weight'};
		    delete $mypackages{$pkgid};
		}else{
		    #If this is not a home square we should record it
		    $droppedpackages{$pkgid} = {'X' => $others{$id}->{'X'},
					 'Y' => $others{$id}->{'Y'},}
		    if($map[$others{$id}->{'X'}][$others{$id}->{'Y'}] eq '.');
		}
            }elsif ($cmd eq 'X') {
		$others{$id}->{'X'} = shift @data;
            }elsif ($cmd eq 'Y') {
		$others{$id}->{'Y'} = shift @data;
            }
	}

    }
    $others{'Me'} = $others{$me{'ID'}};
    print "I'm at:(".$others{'Me'}->{'X'}.",".$others{'Me'}->{'Y'}.")\n";
}

sub getPackages {
    my @info = split / /, readinfo($socket);
    chomp @info;
    undef %punder;
    while (@info > 3) {
	my $pkgid = shift @info;
	my $pack = {
	    'DestX' => shift @info,
	    'DestY' => shift @info,
	    'Weight' => shift @info,
	};
	$punder{$pkgid} = $pack;
	$packages{$pkgid} = $pack;
    }
}


sub sendCmd {
    my $output = $priority;
    $output .= " ";
    if ($do eq 'N'|| $do eq 'S'|| $do eq 'E'|| $do eq 'W') {
	$output .= "Move $do";
    } elsif ($do eq 'P') {
	$output .= "Pick";
    } elsif ($do eq 'D') {
	$output .= "Drop";
    }
    if ($do eq 'P' || $do eq 'D') {
	foreach my $item (@items) {
	    $output .= " ".$item;
	}
    }
    $output .= "\n";
    print $socket $output;
    $fuel -= abs($priority);

}

sub findSpace {
    my $xpos = $others{'Me'}->{'X'};
    my $ypos = $others{'Me'}->{'Y'};
    my (%tofill, %filling);
    $filling{$xpos.','.$ypos} = 1;
    do {
	foreach my $point (keys %filling) {
	    ($xpos,$ypos) = split /\,/, $point;
	    if ($map[$xpos][$ypos] eq '.' || $map[$xpos][$ypos] eq '@') {
		$posmap[$xpos][$ypos] = $map[$xpos][$ypos];
		#now check the surounding N,S,E,W and add them to the tofill hash if they are not .
		if ($map[$xpos + 1][$ypos] && ($map[$xpos + 1][$ypos] eq '.' || $map[$xpos + 1][$ypos] eq '@') && ! $posmap[$xpos + 1][$ypos]) {
		    $tofill{($xpos + 1).','.$ypos} = 1;
		}
		if ($map[$xpos - 1][$ypos] && ($map[$xpos - 1][$ypos] eq '.' || $map[$xpos - 1][$ypos] eq '@' )&& ! $posmap[$xpos - 1][$ypos] ) {
		    $tofill{($xpos - 1).','.$ypos} = 1;
                }
                if ($map[$xpos][$ypos + 1] && ($map[$xpos][$ypos + 1] eq '.' || $map[$xpos][$ypos + 1] eq '@' )&& ! $posmap[$xpos][$ypos + 1]) {
		    $tofill{$xpos.','.($ypos + 1)} = 1;
                }
                if ($map[$xpos][$ypos - 1] && ($map[$xpos][$ypos - 1] eq '.' || $map[$xpos][$ypos - 1] eq '@' )&& ! $posmap[$xpos][$ypos - 1]) {
		    $tofill{$xpos.','.($ypos - 1)} = 1;
                }

	    } #else we just ignore it
	}
	%filling = %tofill;
	undef %tofill;
    } while (keys %filling);
}


sub compute {
    my ($xpos, $ypos) = ($others{'Me'}->{'X'}, $others{'Me'}->{'Y'});
    undef $do;
    undef $priority;
    if(radarcheck()) {
	#We have someone close by, lets confuse them.
	return;
    }

    if (!$goingtoX || !$goingtoY) {
	#we need a goal
	getgoal();
    }
    if ($xpos == $goingtoX && $ypos == $goingtoY ) {
	if ($goal eq 'P') {
	    pickup();
	} elsif ($goal eq 'D') {
	    dropoff();
	}
	getgoal();
    } else {
	if (!$route[$xpos][$ypos]) {
	    #we are off our route, route again;
	    routeTo($goingtoX, $goingtoY);
	}
	delete $route{$xpos.','.$ypos};
	undef $route[$xpos][$ypos];
	my $count;
	$count .= 'N' if $route[$xpos][$ypos+1];
	$count .= 'S' if $route[$xpos][$ypos-1];
        $count .= 'E' if $route[$xpos+1][$ypos];
        $count .= 'W' if $route[$xpos-1][$ypos];
	if ($count && length($count) == 1) {
	    $do = $count;
	} else {
	    $count = 'NSEW' if !$count;
	    $do = substr($count,int(rand(length($count))),1,'');
	    foreach my $dir (split //,$count) {
		undef $route[$xpos][$ypos+1] if $count =~ /N/;
		undef $route[$xpos][$ypos-1] if $count =~ /S/;
		undef $route[$xpos+1][$ypos] if $count =~ /E/;
		undef $route[$xpos-1][$ypos] if $count =~ /W/ ;
	    }
	    cleanroute();
	}
    }
    $priority = 1;
    $do = ('N','S','E','W')[int(rand(4))] if !$do;
}

sub getgoal {
    my @pkgids = keys %mypackages;
    if (@pkgids) {
	#we have something to deliver
	#we could work out nearest, but sod it
	my $pkgid = rand(@pkgids);
	$goingtoX = $packages{$pkgids[$pkgid]}->{'DestX'};
	$goingtoY = $packages{$pkgids[$pkgid]}->{'DestY'};
	$goal = 'D';
    } else {
	#we want to find nearest and get a package from it
	my ($xpos,$ypos) = findnearest();
	$goal = 'P';
	$goingtoX = $xpos;
	$goingtoY = $ypos;
    }
    if (!$goingtoX || !$goingtoY) {
	$goal = 'P';
	$goingtoX = $others{'Me'}->{'X'};
	$goingtoY = $others{'Me'}->{'Y'};
    }
}

sub pickup {
    my $tempcap = $me{'Strength'} - $carrying;
    undef @items;
    #insert cunning bin packing algorithm here
    if (!keys %punder) {
	# we have nothing to pick up at this base, lets bugger off else where and forget about it
	$nearestmap[$others{'Me'}->{'X'}][$others{'Me'}->{'Y'}] = '.';
	getgoal();
    }
    $do = 'P';
    foreach my $pkgid (keys %punder) {
	if ($packages{$pkgid}->{'Weight'} < $tempcap) {
	    push @items, $pkgid;
	    $tempcap -= $packages{$pkgid}->{'Weight'};
	}
    }
}

sub dropoff {
    undef @items;
    foreach my $pkgid (keys %mypackages) {
	if ($packages{$pkgid}->{'DestX'} == $others{'Me'}->{'X'} &&
	    $packages{$pkgid}->{'DestY'} == $others{'Me'}->{'Y'})
	{
	    $do = 'D';
	    push @items, $pkgid;
		
	}
    }
}

sub findnearest {
    my $xpos = $others{'Me'}->{'X'};
    my $ypos = $others{'Me'}->{'Y'};
    my @area; 
    my (%tofill, %filling);
    $filling{$xpos.','.$ypos} = 1;
    do {
        undef %tofill;

        foreach my $point (keys %filling) {
            ($xpos,$ypos) = split /\,/, $point;
	    next if !$nearestmap[$xpos][$ypos];
	    if ($nearestmap[$xpos][$ypos] eq '@') {
		return $xpos,$ypos;
	    }
            if ($nearestmap[$xpos][$ypos] eq '.') {
                $area[$xpos][$ypos] = $nearestmap[$xpos][$ypos];
                #now check the surounding N,S,E,W and add them to the tofill hash if they are not .
                if ($nearestmap[$xpos + 1][$ypos] && ($nearestmap[$xpos + 1][$ypos] eq '.' || $nearestmap[$xpos + 1][$ypos] eq '@') && ! $area[$xpos + 1][$ypos]) {
                    $tofill{($xpos + 1).','.$ypos} = 1;
                }
                if ($nearestmap[$xpos - 1][$ypos] && ($nearestmap[$xpos - 1][$ypos] eq '.' || $nearestmap[$xpos - 1][$ypos] eq '@' )&& ! $area[$xpos - 1][$ypos]) {
                    $tofill{($xpos - 1).','.$ypos} = 1;
                }
                if ($nearestmap[$xpos][$ypos + 1] && ($nearestmap[$xpos][$ypos + 1] eq '.' || $nearestmap[$xpos][$ypos + 1] eq '@' )&& ! $area[$xpos][$ypos + 1]) {
                    $tofill{$xpos.','.($ypos + 1)} = 1;
                }
                if ($nearestmap[$xpos][$ypos - 1] && ($nearestmap[$xpos][$ypos - 1] eq '.' || $nearestmap[$xpos][$ypos - 1] eq '@' )&& ! $area[$xpos][$ypos - 1]) {
                    $tofill{$xpos.','.($ypos - 1)} = 1;
                }

            } #else we just ignore it
        }
        %filling = %tofill;
    } while (keys %filling);
    #now try some dropped pkgs
    #we might have made a mistake
    @nearestmap = @{copymap(\@map)};
    foreach my $ref (values %droppedpackages) {
	$nearestmap[$ref->{'X'}][$ref->{'Y'}] = '@' if $map[$ref->{'X'}][$ref->{'Y'}] ne '@';
    }
}

sub radarcheck {

}

sub routeTo {
    my $destX = shift;
    my $destY = shift;
    if (!$destX || !$destY) {
	getgoal();
	$destX = $goingtoX;
	$destY = $goingtoY;
    }
    print "routing to $destX,$destY\n" if $debug;
    if (!$posmap[$destX][$destY]) {
	print "no route to host\n" if $debug;
	return 0
    }
    #now we know we can get there lets start filling.
    my $xpos = $others{'Me'}->{'X'};
    my $ypos = $others{'Me'}->{'Y'};
    my (%tofill, %filling);
    $filling{$xpos.','.$ypos} = 1;
    do {       
	undef %tofill;
	if ($filling{$destX.','.$destY}) {
	    $route[$destX][$destY] = $map[$destX][$destY];
	    $route{$destX.','.$destY} = 1;
	    undef %filling;
	}
	
        foreach my $point (keys %filling) {
            ($xpos,$ypos) = split /\,/, $point;
            if ($map[$xpos][$ypos] eq '.' || $map[$xpos][$ypos] eq '@' ) {
                $route[$xpos][$ypos] = $map[$xpos][$ypos];
		$route{$xpos.','.$ypos} = 1;
                #now check the surounding N,S,E,W and add them to the tofill hash if they are not .
                if ($map[$xpos + 1][$ypos] && ($map[$xpos + 1][$ypos] eq '.' || $map[$xpos + 1][$ypos] eq '@') && ! $route[$xpos + 1][$ypos]) {
                    $tofill{($xpos + 1).','.$ypos} = 1;
                }
                if ($map[$xpos - 1][$ypos] && ($map[$xpos - 1][$ypos] eq '.' || $map[$xpos - 1][$ypos] eq '@' )&& ! $route[$xpos - 1][$ypos] ) {
                    $tofill{($xpos - 1).','.$ypos} = 1;
                }
                if ($map[$xpos][$ypos + 1] && ($map[$xpos][$ypos + 1] eq '.' || $map[$xpos][$ypos + 1] eq '@' )&& ! $route[$xpos][$ypos + 1]) {
                    $tofill{$xpos.','.($ypos + 1)} = 1;
                }
                if ($map[$xpos][$ypos - 1] && ($map[$xpos][$ypos - 1] eq '.' || $map[$xpos][$ypos - 1] eq '@' )&& ! $route[$xpos][$ypos - 1]) {
                    $tofill{$xpos.','.($ypos - 1)} = 1;
                }

            } #else we just ignore it
        }
	%filling = %tofill;
    } while (keys %filling);
    #we now have a hash of all the points (for speed), and array of all of them (for routing) 
    $goingtoX = $destX;
    $goingtoY = $destY;
    cleanroute();
    #right we SHOULD now have a route, but it can have many paths, when it has to decide it should kill one and then run cleanroute
    return 1;
}

sub cleanroute {
    my @points;
    my %newpoints = %route;
    my ($destX, $destY);
    $destX = $goingtoX;
    $destY = $goingtoY;
    #Now the itteration which will take all the time;
    eval{
	local $SIG{ALRM} = sub{die""};
	alarm(5);
	while(keys %newpoints){
	    @points = keys %newpoints;
	    foreach my $point (@points) {
		my ($xpos,$ypos) = split /\,/, $point;
		next if (($xpos == $others{'Me'}->{'X'} && $ypos == $others{'Me'}->{'Y'}) || ($xpos == $destX && $ypos == $destY));
		my $count = 0;
		($vert, $hoz) = (0 , 0);
		$count++, $vert++ if $route[$xpos+1][$ypos];
		$count++, $vert++ if $route[$xpos-1][$ypos];
		$count++, $hoz++ if $route[$xpos][$ypos+1];
		$count++, $hoz++ if $route[$xpos][$ypos-1];
		if ($count == 0) {
		    delete $route{$xpos.','.$ypos};
		    undef $route[$xpos][$ypos];
		}elsif ($count == 1) {
		    delete $route{$xpos.','.$ypos};
		    undef $route[$xpos][$ypos];
		    $newpoints{($xpos + 1).','.$ypos} = 1 if $route[$xpos + 1][$ypos];
		    $newpoints{($xpos - 1).','.$ypos} = 1 if $route[$xpos - 1][$ypos];
		    $newpoints{$xpos.','.($ypos + 1)} = 1 if $route[$xpos][$ypos + 1];
		    $newpoints{$xpos.','.($ypos - 1)} =1 if $route[$xpos][$ypos - 1];
		}elsif ($count == 2) {
		    if (
			($vert != 2) && ($hoz != 2) &&
			(
			 #check to see if its in a square
			 ($route[$xpos + 1][$ypos +1] && $route[$xpos + 1][$ypos] && $route[$xpos][$ypos + 1]) ||
			 ($route[$xpos + 1][$ypos -1] && $route[$xpos + 1][$ypos] && $route[$xpos][$ypos - 1]) ||
			 ($route[$xpos - 1][$ypos +1] && $route[$xpos - 1][$ypos] && $route[$xpos][$ypos + 1]) ||
			 ($route[$xpos - 1][$ypos -1] && $route[$xpos - 1][$ypos] && $route[$xpos][$ypos - 1])
			 
			 )
			)
			#this has just checked to see if it can be routed around (I think)
		    {
			delete $route{$xpos.','.$ypos};
			undef $route[$xpos][$ypos];
			$newpoints{($xpos + 1).','.$ypos} = 1 if $route[$xpos + 1][$ypos];
			$newpoints{($xpos - 1).','.$ypos} = 1 if $route[$xpos - 1][$ypos];
			$newpoints{$xpos.','.($ypos + 1)} = 1 if $route[$xpos][$ypos + 1];
			$newpoints{$xpos.','.($ypos - 1)} =1 if $route[$xpos][$ypos - 1];
		    }
		    
		}
	    }   
	}
	alarm(0);
    };
    alarm(0);
}



sub printmap {
    my @array = @_;
    foreach my $y (1..($height)) {
        foreach my $x (1..($width)) {
            if ($array[$x][$y]){
                print $array[$x][$y];
            }else {
                print "F";
            }
        }
	print $y;
        print "\n";
    }
}

sub readinfo{
    my $line = readline(shift());
    die "Connection dropped\n" if !$line;
    if ($line =~ /Robot/ || $line =~ /\*\*\*/) {
	print $line;
	readinfo($socket);
	readinfo($socket);
	readinfo($socket);
	$line = readline($socket);
    }
    return $line;
}
