#!/usr/bin/perl
#
# SERENDIPITY
#  by Philip Taylor (philip@zaynar.demon.co.uk)
#

use constant LOGGING => 0;

# use strict;
# use warnings;
# [turned off to make it (potentially) more tolerant of the many faults]

use constant DEBUG => 0;
use constant VERBOSE => 0;

use constant PLAIN => 0;
use constant WATER => 1;
use constant HOMEBASE => 2;
use constant WALL => 3;
use constant X => 0;
use constant Y => 1;
use constant POS => 0;
use constant PACKAGES => 1;


use constant BID_FACTOR => 0.4; # multiplies all bids (which are all fractions of the starting money)

use constant BID_AVOIDWATER => 0.2;
use constant BID_DROWN => 0.2;
use constant BID_PUSHPACK => 0.05;
use constant BID_MOVETOPUSH => [-1];
use constant BID_PICK => [1];
use constant BID_MOVETOPICK => [1];
use constant BID_MOVETOBASE => [1];
use constant BID_DROP => 0.1;
use constant BID_MOVETODROP => [1];
use constant VIOLENT => 0; # determines whether it'll try to push people

my ($host_name, $host_port) = @ARGV;

$host_name ||= 'icfp1.cse.ogi.edu';
$host_port ||= 22001;

if (LOGGING) {
  my $log_file = "log_".time.".txt";
  open LOG_FH, ">$log_file" or die "Error opening log file $log_file for output: $!";
  LOG_FH->autoflush(1);
}

use IO::Socket;

my $socket = IO::Socket::INET->new(
  Proto    => 'tcp',
  PeerAddr => $host_name,
  PeerPort => $host_port)
    or die "Error connecting to server ($host_name:$host_port)";

print "Connected\n" if DEBUG;

$socket->print("Player\n");

my $board = {};
my $config = {};
my $robots = []; # each robot stores [ [x, y], [package ids] ]
my $packages = []; # each package stores [ pos, weight, [dest_x, dest_y], at_base, pickup_turn ] where pos is EITHER [x, y] OR carrier-id
my $bases = []; # each base stores [ [x, y], num packages ] (num=-1 if unvisited)
my %self_data = ( carry => 0 );

my @pf_cache; # store [ turn, node, time of calculation, [target x,y], [nodes in path] ]
              # (used for caching -- gets forgotten several turns after
              # moving out of that node, assuming it didn't take forever
              # to calculate in which case it's still valuable)

my $last_target; # store [ turn, [target x,y] ] -- an attempt to avoid infinitely running backwards and forwards

my $last_action = ''; # to avoid going N/S/N/S/N/S etc, forever
my $deadlock = 0;

my $num_robots; # so that when I'm alone, I don't worry about other people

receive_board();

receive_config();

receive_response();
my $self = $robots->[$config->{uid}];

print "I am at $self->[POS][X] , $self->[POS][Y]\n" if DEBUG;

my $turn_time = 0;
my $turn_num = 0;
my $error_freq = 0;
while (1) {
  ++$turn_num;

  print "\nMn:$config->{currentmoney} Sc:$config->{score} B:", scalar(grep defined $_, @$robots), " " if DEBUG;

  eval { # allow it to (potentially) continue after 'fatal' errors (eval isn't inefficient when used this way)

    receive_packages();
  
  #  $turn_time -= (times)[0] if DEBUG; # (calculate average turn time)
    $turn_time = -(times)[0] if DEBUG; # (calculate each turn separately)
    # issue a command
    my ($amount, $command) = choose_command();
    $turn_time += (times)[0] if DEBUG;
    print sprintf('%.6f', $turn_time/$turn_num), "sec " if DEBUG;
  
    $config->{currentmoney} -= $amount;
    print qq{>"$amount $command" } if DEBUG;
    $socket->print("$amount $command\n");
  
    receive_response();
  };

  if ($@) {
    ++$error_freq;
    die $@ if DEBUG;
    if ($error_freq > 15) { # lots of fatal errors -- try resetting some easily-resettable stuff
      @pf_cache = ();
      $packages = [];
    }
    if ($error_freq > 25) { # too many fatal errors -- give up
      die "Too many fatal errors!";
    }
  } else {
    $error_freq -= 2 if $error_freq > 0;
  }

}


sub choose_command {

  my @choices; # [weight, bid, move] (amount is always a fraction of the starting amount)

  my $nearby_bots = 0;
  my $adjacent_bots;

  push @choices, [-1, [1], 'Drop', 'Default action', undef];

  # Create a list of possible amounts/moves with a weighting (generally 0..1ish)
  # At the end, combine identical moves, choose one with highest rating

  my ($distance, $relative_pos);

  $num_robots = scalar(grep defined $_, @$robots > 1);

  if ($num_robots > 1) {

    # There are some other robots in here
    foreach my $bot (grep defined $_, @$robots) {
      next if $bot == $self;
      $relative_pos = [$bot->[POS][X]-$self->[POS][X], $bot->[POS][Y]-$self->[POS][Y]];
      $distance = abs($relative_pos->[0])+abs($relative_pos->[1]);

      # If they're adjacent
      if ($distance == 1) {
        print "Adjacent bot\n" if VERBOSE;

        $nearby_bots++;
        $adjacent_bots ||= [];
        push @$adjacent_bots, $bot;

        # look for water in their direction
        # (should be changed to understand multiple-pushings)
        if (($relative_pos->[0] and
            vec($board->{data}, ($bot->[POS][X]+$relative_pos->[0])+($bot->[POS][Y])*$board->{realwidth}, 2) == WATER)
         or ($relative_pos->[1] and
            vec($board->{data}, ($bot->[POS][X])+($bot->[POS][Y]+$relative_pos->[1])*$board->{realwidth}, 2) == WATER)) {
          # push them into the water
          print "Attempting to drown\n" if VERBOSE;
          push @choices, [ 4, BID_DROWN, move_command($bot->[POS]), 'Try to drown', undef ];
        }

        # look for water in *my* direction
        if (($relative_pos->[0] and
            vec($board->{data}, ($self->[POS][X]-$relative_pos->[0])+($self->[POS][Y])*$board->{realwidth}, 2) == WATER)
         or ($relative_pos->[1] and
            vec($board->{data}, ($self->[POS][X])+($self->[POS][Y]-$relative_pos->[1])*$board->{realwidth}, 2) == WATER)) {
          # avoid the water
          print "Avoiding water\n" if VERBOSE;
          my @directions = ([$self->[POS][X], $self->[POS][Y]+1, 0],
                            [$self->[POS][X], $self->[POS][Y]-1, 0],
                            [$self->[POS][X]+1, $self->[POS][Y], 0],
                            [$self->[POS][X]-1, $self->[POS][Y], 0]);
          # Make the third value contain the badness of that direction
          foreach (@directions) {
            $_->[2] += 10 if vec($board->{data}, $_->[X]+$_->[Y]*$board->{realwidth}, 2) & 1;
            $_->[2] += 1 if $bot->[POS][X] == $_->[X] and $bot->[POS][Y] == $_->[Y];
          }
          my $least_bad_direction = (sort { $a->[2] <=> $b->[2] } @directions)[0];
          push @choices, [ 5, BID_AVOIDWATER, move_command([ $least_bad_direction->[X], $least_bad_direction->[Y] ]), 'Avoid drowning', undef ];
        }


        # If they've got some packages
        if (VIOLENT and $bot->[PACKAGES] and @{$bot->[PACKAGES]}) {
          print "They have some packages\n" if VERBOSE;

          # and I don't have enough
          if ($self_data{carry}/$config->{capacity} < 0.1) {
            print "I have very few but want some\n" if VERBOSE;
            push @choices, [ 0.5, 2*BID_PUSHPACK, move_command($bot->[POS]), 'Push', undef ];

          } elsif ($self_data{carry}/$config->{capacity} < 0.75) {
            print "I have some but want some more\n" if VERBOSE;
            push @choices, [ 0.2, BID_PUSHPACK, move_command($bot->[POS]), 'Push', undef ];
          }
        }

      # If they're close
      } elsif (VIOLENT and $distance == 2) {
        ++$nearby_bots;
        push @choices, [ 0.1, BID_MOVETOPUSH, move_command($bot->[POS]), 'Move to enemy', undef ];
      }
    }
  }

  foreach my $package (grep { $_            # only allow defined
                          and ref($_->[0])  # and not carried by a robot
                          and (not $_->[1]  # and with an unknown or light enough weight
                              or $_->[1] <= $config->{capacity} - $self_data{carry})
                    } @$packages) {

    $relative_pos = [$package->[POS][X]-$self->[POS][X], $package->[POS][Y]-$self->[POS][Y]];
    $distance = abs($relative_pos->[0])+abs($relative_pos->[1]);

    # If I'm standing on top of it
    if ($distance == 0) {
      push @choices, [ 1, BID_PICK, 'Pick', 'Picking package' ];
 
    # If it's reasonably close (but ignoring homebased ones)
    } elsif ($distance < 5 and $package->[3] != -1) {
      push @choices, [ (0.2+(0.1/$distance))*($package->[4]?0.2:1), BID_MOVETOPICK, [$package->[POS], 1], 'Move to package', $package->[POS] ];

    }
  }


  # If I'm not carrying too much
  if ($self_data{carry}/$config->{capacity} < 0.75 and @$bases) {
    my @base_matches;
BASE:
    foreach my $base (@$bases) {
      next if $base->[PACKAGES] == 0; # ignore those known to have no packages
          # (=package count! not list)

      $relative_pos = [$base->[POS][X]-$self->[POS][X], $base->[POS][Y]-$self->[POS][Y]];
      $distance = abs($relative_pos->[0])+abs($relative_pos->[1]);

      next if $distance == 0; # ignore ones I'm standing on

      # Be nice and don't push other bots out of the way on bases (which usually leads to an almost-infinite loop)
      if ($distance == 1 and $adjacent_bots) {
        foreach my $bot (@$adjacent_bots) {
          if ($bot->[POS][X] == $base->[POS][X] and $bot->[POS][Y] == $base->[POS][Y]) {
            next BASE;
          }
        }
      }
      push @base_matches, [ $base, $distance - 2*$base->[PACKAGES]]; # favour places with lots of packages
    }
    if (@base_matches) {
      @base_matches = sort { $a->[1] <=> $b->[1] } @base_matches;
MATCHES:
      foreach my $best_match (@base_matches) {
        if ($best_match->[0][PACKAGES] == -1) { # if unknown, check it out
          push @choices, [ 0.3+(1/max(int($best_match->[1]),1)), BID_MOVETOBASE, [$best_match->[0][POS], 10], 'Move to base', $best_match->[0][POS]];
          last MATCHES;
        }
        foreach my $package (@$packages) { # look to check that any are light enough
          next unless defined $package; # ignore undefined
          next if $package->[3] == -1; # ignore not-on-bases
          next unless $bases->[$package->[3]] == $best_match->[0]; # ignore not-on-this-base
          next unless $package->[1] <= $config->{capacity} - $self_data{carry}; # ignore too-heavy
          push @choices, [ 0.2+(1/max(int($best_match->[1]),1)), BID_MOVETOBASE, [$best_match->[0][POS], 10], 'Move to base', $best_match->[0][POS]];
          last MATCHES;
        }
      }
    }
  }

  if ($self->[PACKAGES] and @{$self->[PACKAGES]}) {
    my @immediate_drops;
    foreach my $package_id (@{$self->[PACKAGES]}) {
      $relative_pos = [$packages->[$package_id][2][X] - $self->[POS][X], $packages->[$package_id][2][Y] - $self->[POS][Y]];
      $distance = abs($relative_pos->[0])+abs($relative_pos->[1]);
      my $hold_time = $turn_num - $packages->[$package_id][5];
      if ($distance == 0) {
        push @immediate_drops, $package_id;
      } else {
        push @choices, [ 0.5 + min(3,(1.8**($hold_time/20))-1), BID_MOVETODROP, [$packages->[$package_id][2], 10], 'Move to dest', $packages->[$package_id][2] ];
      }
    }
    if (@immediate_drops) {
      push @choices, [ 5*@immediate_drops, BID_DROP, join(' ', 'Drop', @immediate_drops), 'Dropping', undef ];
    }

  }

  # If there's nobody near me, and I was heading somewhere last turn, carry on
  if (not $nearby_bots and $last_target and $turn_num-$last_target->[0] < int(rand 8)) {
    push @choices, [ 1.3, [1], [$last_target->[1], 1], 'Continuing', [$last_target->[1]] ];
  }


  # (all that does something vaguely like this:

  # Check for adjacent robots
  #  If it would knock them or someone else into water, do it (very high bid)
  #  If they're carrying lots of packages, and I'm not, push them

  # Look for packages here
  #  If there are any, pick up as many as the weight limit allows, starting with the lightest (makes pushes less bad)

  # Look for packages nearby (4?? squares direct)
  #  Estimate average weight and destination-distance if unknown
  #  Ignore all that are too heavy
  #  Calculate their real distance
  #  Move towards them (weighting = 1/real distance)

  # Check for robots adjacent diagonally, or two squares horiz/vertical (check for obstructions)
  #  If carrying no/not many packages (<25%?? capacity) , move towards them (low bid) (weighting = 0.5??)

  # Look for homebases
  #  Ignore those who are known to not have any light enough
  #  Get number of packages there (guess, or remember from previous visits)
  #  Multiply by nearness (1/direct distance)
  #  Starting with the highest, calculate packages*nearness, ignoring those who are already much lower than the best result
  #  Move towards them

  # Look for the destinations
  #  Calculate direct distance
  #  Starting with the lowest, pathfind real distance; ignore any whose direct distance is much bigger than lowest actual distance
  #  Go towards that location (weighting = sum of weight of packages for that destination * 4?? / capacity)

  my %final_choices;

  my $self_region;
CHOICES:
  foreach (@choices) {
    my ($weighting, $amount, $action, $text, $target_rem) = @$_;
    if (ref $action) {
      my ($target, $limit) = @$action;

      $self_region = pos_to_region($self->[POS]) unless defined $self_region;
      my $target_region = pos_to_region($target);

      # If it's in the same region as me
      if ($target_region == $self_region) {
        $action = move_command(interior_pathfind($self->[POS], $target));

      # otherwise work out what region I need to visit next
      } else {

        my $pf_return = pathfind( $self->[POS], $target, $limit );
        if ($pf_return->[0] eq 'found') {
          $action = move_command(interior_pathfind($self->[POS], $pf_return->[1][1]));
        } else {
          next CHOICES;
        }
      }
      next CHOICES unless $action; # ignore invalid movements
    }

    # Don't walk into water/walls
    next CHOICES if $action eq 'Move N' and vec($board->{data}, $self->[POS][X]+($self->[POS][Y]+1)*$board->{realwidth}, 2) & 1;
    next CHOICES if $action eq 'Move S' and vec($board->{data}, $self->[POS][X]+($self->[POS][Y]-1)*$board->{realwidth}, 2) & 1;
    next CHOICES if $action eq 'Move E' and vec($board->{data}, $self->[POS][X]+1+($self->[POS][Y])*$board->{realwidth}, 2) & 1;
    next CHOICES if $action eq 'Move W' and vec($board->{data}, $self->[POS][X]-1+($self->[POS][Y])*$board->{realwidth}, 2) & 1;

    next CHOICES if $deadlock > 10 and not $nearby_bots and
      (($action eq 'Move N' and $last_action eq 'Move S') or
       ($action eq 'Move S' and $last_action eq 'Move N') or
       ($action eq 'Move E' and $last_action eq 'Move W') or
       ($action eq 'Move W' and $last_action eq 'Move E'));

    if (ref $amount) {
      $amount = $amount->[0];
    } else {
      $amount = $amount * $config->{money} * BID_FACTOR;
    }
    if ($final_choices{$action}) {
      $final_choices{$action}[0] += $weighting; # add the weightings
      $final_choices{$action}[1] = max($amount, $final_choices{$action}[1]); # choose the highest bid
    } else {
      $final_choices{$action} = [ $weighting, $amount, $text, $target_rem ];
    }
  }
  my $final_choice = (sort { $final_choices{$b}[0] <=> $final_choices{$a}[0] } keys %final_choices)[0];

  my $action = $final_choice;
  if ($action eq 'Pick') {
    # get as many packages as possible, starting with the lightest
    my @packages_here = sort { $packages->[$a][1] <=> $packages->[$b][1] } grep { $packages->[$_] and ref($packages->[$_][0]) and $packages->[$_][0][X]==$self->[POS][X] and $packages->[$_][0][Y]==$self->[POS][Y] } 0..$#$packages;
    pop @packages_here while @packages_here and sum(map $packages->[$_][1], @packages_here) > $config->{capacity}-$self_data{carry};
    $action = join ' ', 'Pick', @packages_here;
  }

  if ($final_choices{$final_choice}[3]) {
    if (ref $final_choices{$final_choice}[3][0]) {
      $last_target->[1] = $final_choices{$final_choice}[3][0];
    } else {
      $last_target = [$turn_num, $final_choices{$final_choice}[3]];
    }
  } else {
    undef $last_target;
  }

  my $amount;
  if (not $nearby_bots) {
    $amount = 1;
  } else {
    $amount = $final_choices{$final_choice}[1];
    if (abs($amount) < 1) {
      $amount = $amount<0 ? -1 : 1;
    } else {
      $amount = int($amount);
    }
  }
  print "*$final_choices{$final_choice}[2]* " if DEBUG;

  if (not $nearby_bots and
      (($action eq 'Move N' and $last_action eq 'Move S') or
       ($action eq 'Move S' and $last_action eq 'Move N') or
       ($action eq 'Move E' and $last_action eq 'Move W') or
       ($action eq 'Move W' and $last_action eq 'Move E'))) {
    $deadlock++;
  } else {
    $deadlock--;
    $deadlock = 0 if $deadlock < 0;
  }

  $last_action = $action;

  return ($amount, $action);
}

sub move_command {
  my $new_pos = shift;
  if ($new_pos->[Y] > $self->[POS][Y]) {
    return "Move N";
  } elsif ($new_pos->[Y] < $self->[POS][Y]) {
    return "Move S";
  } elsif ($new_pos->[X] > $self->[POS][X]) {
    return "Move E";
  } elsif ($new_pos->[X] < $self->[POS][X]) {
    return "Move W";
  } else {
    return undef;
  }
}

sub interior_pathfind {
  my ($from, $to) = @_;
  # work out movement $from->$to, knowing that they're both within
  # the same unobstructed square, preferably avoiding water
  # (returning a position for move_command)
  # Or move from one square to another

  if (not ref $to) { # allow $to to be a section id
    my $pos = [];
    $pos->[$_] = between($from->[$_], $board->{pf_sections}[$to][$_], $board->{pf_sections}[$to][$_+2]) foreach (X, Y);
    $to = $pos;
  }

  # if it's a straight line
  if ($to->[X] == $from->[X] or $to->[Y] == $from->[Y]) {
    return $to;
  }

  my @directions; # 1/-1 -> R/L, U/D  (work out the two possible movements)
  $directions[0] = ($to->[X] > $from->[X]) ? 1 : -1;
  $directions[1] = ($to->[Y] > $from->[Y]) ? 1 : -1;

  my $from_region = pos_to_region($from);

  # If one way is in a different region, don't go there
  if (not
     ($board->{pf_sections}[$from_region][0] <= $from->[X]+$directions[0] and
      $board->{pf_sections}[$from_region][2] >= $from->[X]+$directions[0] and
      $board->{pf_sections}[$from_region][1] <= $from->[Y] and
      $board->{pf_sections}[$from_region][3] >= $from->[Y])) {
    return [ $from->[X], $from->[Y]+$directions[1] ];
  }
  if (not
     ($board->{pf_sections}[$from_region][0] <= $from->[X] and
      $board->{pf_sections}[$from_region][2] >= $from->[X] and
      $board->{pf_sections}[$from_region][1] <= $from->[Y]+$directions[1] and
      $board->{pf_sections}[$from_region][3] >= $from->[Y]+$directions[1])) {
    return [ $from->[X]+$directions[0], $from->[Y] ];
  }

  # don't walk into water
  if (vec($board->{data}, $from->[X]+$directions[0] + $from->[Y]*$board->{realwidth}, 2) == WATER) {
    return [ $from->[X], $from->[Y]+$directions[1] ];
  }
  if (vec($board->{data}, $from->[X]+($from->[Y]+$directions[1])*$board->{realwidth}, 2) == WATER) {
    return [ $from->[X]+$directions[0], $from->[Y] ];
  }

  if ($num_robots > 1) {
    # move away from water (if it's one behind in one direction, move that direction to get further away)
    if (vec($board->{data}, $from->[X]-$directions[0] + $from->[Y]*$board->{realwidth}, 2) == WATER) {
      return [ $from->[X]+$directions[0], $from->[Y] ];
    }
    if (vec($board->{data}, $from->[X]+($from->[Y]-$directions[1])*$board->{realwidth}, 2) == WATER) {
      return [ $from->[X], $from->[Y]+$directions[1] ];
    }
  }

  if (int rand 2) { # choose one randomly
    return [ $from->[X]+$directions[0], $from->[Y] ];
  } else {
    return [ $from->[X], $from->[Y]+$directions[1] ];
  }
}

sub pathfind {
  my ($from, $to, $limit) = @_;

  my $time = (times)[0];
  $limit = $time + $limit if $limit;

  foreach ($from, $to) {
    if ($_->[X] < 1 or $_->[X] > $board->{size}[X] or
        $_->[Y] < 1 or $_->[Y] > $board->{size}[Y] or
        vec($board->{data}, $_->[X] + $_->[Y] * $board->{realwidth}, 2) & 1
    ) {
      print "Invalid start/end position!\n" if DEBUG;
      return ['failed', undef];
    }
  }

#  Start at region s
#  Look at each adjacent region, calculate the distance to walk to there,
#  and the new exact position.
#  Guess the distance from that position to the target (dx+dy)
#  Starting with the lowest, repeat

  my $from_region = pos_to_region($from);
  my $target_region = pos_to_region($to);

  # Use cached data
  foreach my $cached (@pf_cache) {

    # check for expiration first (age > 5 turns, and > 2*calculation time
    if ($turn_num-$cached->[0] > 5 and $turn_num-$cached->[0] > 5*$cached->[2]) {
      undef $cached;
      @pf_cache = grep defined $_, @pf_cache;
      next;
    }
    my ($start, $end);
    for (0..$#{$cached->[4]}) {
      if ($cached->[4][$_] == $from_region) {
        $start = $_;
        last;
      }
    }
    if (defined $start) {
      for (reverse $start..$#{$cached->[4]}) {
        if ($cached->[4][$_] == $target_region) {
          $end = $_;
          last;
        }
      }
      if (defined $end) {
        my @new_route = @{$cached->[4]}[$start..$end];
        return ['found', \@new_route];
      }
    }
  }

  my $start = [
    $from, # exact position
    $from_region, # region id
    0, # distance from $from to here
    abs($from->[X] - $to->[X]) + abs($from->[Y] - $to->[Y]), # rough distance from here to $to
    undef, # parent
  ];

  my @open = ($start);
  my @closed = ();

  my $c = 0;

  my ($node, $other_node, @connections, $connected, $pos, $replace);

  while (@open) {
    ++$c;
    @open = sort { $b->[3] <=> $a->[3] } @open;
    $node = pop @open;
    if ($node->[1] == $target_region) {
      print "Found(in $c steps) " if DEBUG;
      my @route;
      do { unshift @route, $node->[1] } while defined($node = $node->[4]);
      print "{", (join ' ', @route), "}" if DEBUG;

      $time = $time - (times)[0];
      push @pf_cache, [ $turn_num, $from_region, $time, $to, \@route ];

      return ['found', \@route];
    }
    if ($limit and (times)[0] >= $limit) {
      print "Given up after $c steps!\n" if DEBUG;
      my @route;
      do { unshift @route, $node->[1] } while defined($node = $node->[4]);
      return ['found', \@route];
    }

    # Calculate connected regions (if not already calculated)
    if (not $board->{pf_sections}[$node->[1]][4]) {
      my ($s1, $s2) = ($node->[1], 0);
      my $squares = $board->{pf_sections};
      for $s2 (0..$#$squares) {
        if (
            ($squares->[$s1][0] == $squares->[$s2][2] + 1 and
             $squares->[$s1][1] <= $squares->[$s2][3] and
             $squares->[$s1][3] >= $squares->[$s2][1])
         or ($squares->[$s1][1] == $squares->[$s2][3] + 1 and
             $squares->[$s1][0] <= $squares->[$s2][2] and
             $squares->[$s1][2] >= $squares->[$s2][0])
         or ($squares->[$s2][0] == $squares->[$s1][2] + 1 and
             $squares->[$s2][1] <= $squares->[$s1][3] and
             $squares->[$s2][3] >= $squares->[$s1][1])
         or ($squares->[$s2][1] == $squares->[$s1][3] + 1 and
             $squares->[$s2][0] <= $squares->[$s1][2] and
             $squares->[$s2][2] >= $squares->[$s1][0])
           ) {
          push @{$squares->[$s1][4]}, $s2;
        }
      }
    }

    # For each connected region
    foreach $connected ( @{$board->{pf_sections}[$node->[1]][4]} ) {

      # Calculate the closest position I'll end up at
      $pos->[$_] = between($node->[0][$_], $board->{pf_sections}[$connected][$_], $board->{pf_sections}[$connected][$_+2]) foreach (X, Y);

      $replace = 1;

      # a not-quite-perfect shorter-distance guesser (doesn't care about where in the node you end up)
      my $distance_to_here = $node->[1] + abs($pos->[X] - $node->[0][X]) + abs($pos->[Y] - $node->[0][Y]);

      foreach $other_node (@open, @closed) {
        if ($other_node->[1] == $connected) {
          if ($distance_to_here >= $other_node->[2]) { # this is further than the older way
            $replace = 0;
            last;
          } else {
            $other_node = undef; # delete the old node
            @closed = grep defined $_, @closed;
            @open = grep defined $_, @open;
            last;
          }
        }
      }
      if ($replace) {
        push @open, [
          $pos,
          pos_to_region($pos),
          $distance_to_here, # $from to here
          $distance_to_here + abs($pos->[X] - $to->[X]) + abs($pos->[Y] - $to->[Y]), # $from to $to through here
          $node,
        ];
      }
    }
    push @closed, $node;
  }
  print "Failed after $c steps!\n" if DEBUG;
  return ['failed', undef];
}

sub pos_to_region {
  my $pos = shift;
  my $s;
  my $squares = $board->{pf_sections};
  for $s (0..$#$squares) {
    if (
      $squares->[$s][0] <= $pos->[X] and
      $squares->[$s][2] >= $pos->[X] and
      $squares->[$s][1] <= $pos->[Y] and
      $squares->[$s][3] >= $pos->[Y]
    ) {
      return $s;
    }
  }
  print "No region for $pos->[0],$pos->[1]!\n" if DEBUG;
  return undef;
}

sub pathfind_init {

  # split board into lots of square passable sections:
  #  start with westest walkable grid square of northest row
  #  expand rightwards by one if possible
  #  expand downwards by one if possible
  #  if no expansion possible, start another square
  #  repeat until no passable squares left
  # calculate adjacent squares:
  #  for each, store a list of squares with touching sides

  # to path find,
  #  do a* (vaguely) search to find a list of squares to pass through
  #  when within a square, use internal_pathfind

  my @squares; # each is [ x1, y1, x2, y2, [ connections ] ]
  my ($x, $y, $x1, $y1, $x2, $y2, $empty, $found_anything, $finished);
  $found_anything = 1;

  my $already_squared = '';
  for $y (0..$board->{size}[Y]+1) {
    for $x (0..$board->{size}[X]+1) {
      vec($already_squared, $x+$board->{realwidth}*$y, 1) = (vec($board->{data}, $x+$board->{realwidth}*$y, 2) & 1) ? 1 : 0;
    }
  }

  while ($found_anything) {
    $found_anything = 0;

    for $y1 (1..$board->{size}[Y]) {
      for $x1 (1..$board->{size}[X]) {

        # Find first empty board square
        if (not vec($already_squared, $x1+$board->{realwidth}*$y1, 1)) {

          $found_anything = 1;
  
          $x2 = $x1; $y2 = $y1; # make it a 1x1 square
          vec($already_squared, $x1+$board->{realwidth}*$y2, 1) = 1;
  
          $finished = 0;
          while (not $finished) {
            $finished = 1;
  
            # Widen it if possible
            $empty = 1;
            for $y ($y1..$y2) {
              if (vec($already_squared, $x2+1+$board->{realwidth}*$y, 1)) {
                $empty = 0;
                last;
              }
            }
            if ($empty) {
              $x2++;
              for $y ($y1..$y2) { # mark the squares as already done
                vec($already_squared, $x2+$board->{realwidth}*$y, 1) = 1;
              }
              $finished = 0;
            }

            # Heighten it if possible
            $empty = 1;
            for $x ($x1..$x2) {
              if (vec($already_squared, $x+$board->{realwidth}*($y2+1), 1)) {
                $empty = 0;
                last;
              }
            }
            if ($empty) {
              $y2++;
              for $x ($x1..$x2) { # mark the squares as already done
                vec($already_squared, $x+$board->{realwidth}*$y2, 1) = 1;
              }
              $finished = 0;
            }
          }
          push @squares, [ $x1, $y1, $x2, $y2, undef ];
        }
      }
    }
  }

  print "Board split into ", scalar(@squares), " sections\n" if DEBUG;

  $board->{pf_sections} = \@squares;
}

sub receive_board {
  $board = {};
  chomp (my $board_dimensions = $socket->getline);
  $board->{size}[X] = (split(/\s+/, $board_dimensions, 2))[0];
  $board->{size}[Y] = (split(/\s+/, $board_dimensions, 2))[1];

  print "Board is ", $board->{size}[X], ' x ', $board->{size}[Y], "\n" if DEBUG;

  print LOG_FH join(' ', $board->{size}[X], $board->{size}[Y]), "\n" if LOGGING;

  my $board_data = '';
  $board->{realwidth} = $board->{size}[X]+2;
  vec($board_data, $_, 2) = WALL for 0..$board->{realwidth}-1;
  for my $row (1..$board->{size}[Y]) {
    chomp(my $row_data = $socket->getline);
    print LOG_FH $row_data, "\n" if LOGGING;

    vec($board_data, $_+$row*$board->{realwidth}, 2) = WALL for (0, $board->{size}[X]+1);

    for (1..$board->{size}[X]) {
      my $char = substr($row_data, $_-1, 1);
      my $value;
      if ($char eq '.') {
        $value = PLAIN;
      } elsif ($char eq '#') {
        $value = WALL;
      } elsif ($char eq '~') {
        $value = WATER;
      } elsif ($char eq '@') {
        $value = HOMEBASE;
        push @$bases, [ [$_, $row], -1 ];
      } else {
        warn "Unrecognised char $value!";
        $value = WALL; # just guess...
      }
      vec($board_data, $_+$row*$board->{realwidth}, 2) = $value;
    }
  }
  vec($board_data, $_+$board->{realwidth}*($board->{size}[Y]+1), 2) = WALL for 0..$board->{realwidth}-1;
  $board->{data} = $board_data;

  pathfind_init();

}

sub receive_config {
  chomp (my $config_data = $socket->getline);
  $config->{uid} =      (split(/\s+/, $config_data, 3))[0];
  $config->{capacity} = (split(/\s+/, $config_data, 3))[1];
  $config->{money} =    (split(/\s+/, $config_data, 3))[2];
  $config->{currentmoney}=$config->{money};
  $config->{score} = 0;
  print "UID: $config->{uid}; capacity: $config->{capacity}; money: $config->{money}\n" if DEBUG;
}

sub receive_response {
  my $used_robots = [];
  my $response_data = $socket->getline;
  if (not defined $response_data or not length $response_data) {
    game_over('connection closed (r)');
  }
  chomp $response_data;
  if ($response_data eq "Robot $config->{uid} died.") {
    if (VERBOSE) {
      print $response_data, "\n";
      print while $_ = $socket->getline;
    }
    game_over('killed (r)');
  }

  print LOG_FH $response_data, "\n" if LOGGING;
  my @responses = split(/\s+/, $response_data);
  my $robot_id = -1;
  while (defined (my $command = shift @responses)) {

    if (substr($command, 0, 1) eq '#') {
      $robot_id = substr($command, 1);
      ++$used_robots->[$robot_id];

    } elsif ($command eq 'N') {
      $robots->[$robot_id][POS][Y] = $robots->[$robot_id][POS][Y]+1;
    } elsif ($command eq 'S') {
      $robots->[$robot_id][POS][Y] = $robots->[$robot_id][POS][Y]-1;
    } elsif ($command eq 'E') {
      $robots->[$robot_id][POS][X] = $robots->[$robot_id][POS][X]+1;
    } elsif ($command eq 'W') {
      $robots->[$robot_id][POS][X] = $robots->[$robot_id][POS][X]-1;

    } elsif ($command eq 'X') {
      $robots->[$robot_id][POS][X] = shift @responses;
    } elsif ($command eq 'Y') {
      $robots->[$robot_id][POS][Y] = shift @responses;

    } elsif ($command eq 'P') {
      my $package_id = shift @responses;

      # If it was in a base
      if (defined $packages->[$package_id] and $packages->[$package_id][3] != -1 and $bases->[$packages->[$package_id][3]][PACKAGES] != -1) {
        $bases->[$packages->[$package_id][3]][PACKAGES]--;
      }

      $packages->[$package_id][0] = $robot_id;
      $packages->[$package_id][3] = -1; # not in a base any more
      $packages->[$package_id][5] = $turn_num;

      push @{$robots->[$robot_id][PACKAGES]}, $package_id;
      if ($robot_id == $config->{uid}) {
        $self_data{carry} += $packages->[$package_id][1];
      }

    } elsif ($command eq 'D') {
      my $package_id = shift @responses;

      if ($robot_id == $config->{uid}) {
        $self_data{carry} -= $packages->[$package_id][1];
      }
      @{$robots->[$robot_id][PACKAGES]} = grep $_ != $package_id, @{$robots->[$robot_id][PACKAGES]};

      # If I know it's been dropped on its destination
      if (ref $packages->[$package_id][2] and
          $packages->[$package_id][2][X] == $robots->[$robot_id][POS][X] and
          $packages->[$package_id][2][Y] == $robots->[$robot_id][POS][Y]) {

        # and if I dropped it, I score
        if ($robot_id == $config->{uid}) {
          $config->{score} += $packages->[$package_id][1];
        }

        undef $packages->[$package_id]; # successfully delivered

      } else {

        # If I don't know the destination, set a "probably-not-here" flag
        if (not ref $packages->[$package_id][2]) {
          $packages->[$package_id][4] = 1;
        }
        $packages->[$package_id][0] = $robots->[$robot_id][POS];
        $packages->[$package_id][3] = -1; # not in a base any more
      }

    } else {
      print "Unrecognised command $command!\n" if DEBUG;
    }
  }
  foreach my $id (0..$#$robots) {
    undef $robots->[$id] unless $used_robots->[$id];
  }
}

sub receive_packages {
  my $package_data = $socket->getline;
  if (not defined $package_data or not length $package_data) {
    game_over('connection closed (p)');
  }
  chomp $package_data;
  if ($package_data eq "Robot $config->{uid} died.") {
    if (VERBOSE) {
      print $package_data, "\n";
      print while $_ = $socket->getline;
    }
    game_over('killed (p)');
  }

  my @packages_data = split(/\s+/, $package_data);
  print "Pk here:", scalar(@packages_data)/4, "  " if VERBOSE;

  print "Held:", scalar(@{$self->[PACKAGES]}), "  " if VERBOSE and $self->[PACKAGES];

  my $base = -1;
  for (0..$#$bases) {
    if ($bases->[$_][POS][X] == $self->[POS][X] and $bases->[$_][POS][Y] == $self->[POS][Y]) {
      $base = $_;
      $bases->[$base][PACKAGES] = 0;
      last;
    }
  }
  foreach (@$packages) {
    # if it ought to be here, delete it now
    if ($_ and ref $_->[POS] and $_->[POS][X] == $self->[POS][X] and $_->[POS][Y] == $self->[POS][Y]) {
      $_ = undef;
    }
  }
  for (1..scalar(@packages_data)/4) {
    my ($id, $dx, $dy, $w) = splice @packages_data, 0, 4;
    $packages->[$id] = [$self->[POS], $w, [$dx, $dy], $base, 0, 0];
    ++$bases->[$base][PACKAGES] if $base != -1;
  }
  print "Badly formed package data! (@packages_data)\n" if DEBUG and @packages_data;
}

sub game_over {
  my $msg = shift;
  print "Game over! ($msg)\n" if DEBUG;
  exit;
}

sub sum{my$r=0;$r+=${_}foreach@_;$r}
sub max{$_[0]>$_[1]?$_[0]:$_[1]}
sub min{$_[0]<$_[1]?$_[0]:$_[1]}
sub between{$_[0]<$_[1]?$_[1]:$_[0]>$_[2]?$_[2]:$_[0]}
