# $Id: tools.pl,v 2.3 1995/07/08 11:02:14 children Beta $
#
#                       Perl Empire Interface Tools
#
#         Written by Drake Diedrich, Ken Stevens, and Sam Tetherow
#
#
# DESCRIPTION:
# This perl module illustrates how user defined perl tools may be integrated
# into pei.  A list of the tools that it contains may be found in the file
# "tools.man".
#
# INSTALLATION:
# You do not need to do anything to install tools.pl.  It will be automatically
# included into pei when you connect to a game.  Just make sure that it
# is in the same directory as pei when pei is run.  Or you can put tools.pl
# in the directory ~/perl and add the following line to your ~/.login file:
#   setenv PERLLIB ~/perl
# 
# Type "help tools" from within pei for the syntax of tool commands,
# or read the file help.tools that comes with pei.
#
# AUTHORS:
# Drake Diedrich and Ken Stevens co-wrote:
#   nova, xmvr, and router.
# Sam Tetherow and Ken Stevens co-wrote:
#   delta, fdelta, tele, anno, mail, and wmail.
# Ken Stevens wrote:
#   setfood, rebel, reach, sreach, lreach, and civs.
# Sam Tetherow wrote:
#   sneweff, pneweff, lneweff, foreach, wdelta, stat, sstat, pstat, and lstat.
#
# BUG REPORTS:
# mail your bug-reports and comments to:
# Sam Tetherow <tetherow@nol.org>

#       --- Global variables ---
#
# General tool variables:
# %xdir, %ydir      x,y direction vectors
# @dirstr           The six directions
# $maxpath          Maximum path length used by any of the tools
# @desig            Sector designations
# @commo            Commodities
# %weight           Weights of commodities
# %packing          Warehouse packing factors for commodities
# %commstr          Converts 'f' to 'food', etc...
# %target           Contains list of sectors in <SECTS> argument
#
# xmvr variables:
# %minmob           Minimum mob to be left in sector (by designation)
#
# External variables:
# $main'tools_loaded     Used by pei to determine if we need country number

#       --- Functions ---
#
# Initialization functions:
# xmvr_init       Initialize variables used by xmvr
# comm_init       Initialize commodity variables
# buildcost_init  Initialize variables used by buildcost
# 
# Buildcost functions:
# wrap            If sector co-ords wrap around the world, fix them
# adjacent        Return an array of the six sectors adjacent to arg
# movcost         The mob cost to move into sector arg
# buildcost       Build up path costs for nearby sectors
#
# Nova functions:
# border_sectors  Find unowned '-' sectors on my border
# makepath        Find the cheapest path to an unowned sector
# nova            Explore into adjacent unowned '-' sectors
# tools_supernova Keep calling nova until all '-' are explored
#
# xmvr functions:
# do_move         Move a commodity from one sector to another
# tools_xmvr      Move commodities based on $maxciv, $maxuw, or thresh
#
# Router functions:
# useless         Return a list of sectors in need of redesignation
# tools_router    Dist sectors to the nearest warehouse
#
# Setfood functions:
# tools_setfood   Set food thresholds for maximum civ growth
#
# External functions:
# main'find_country_number   Find my country number
# main'tools_init            Set $country, $coun, $btus, and $timeused
#
# Sam Tetherow's Functions
# tools_landeff        user interface for build_units
# build_units          Actual unit calculations
# tools_planeeff       user interface for build_planes
# build_planes         Actual plane calculations
# tools_shipeff        user interface for build_ships
# build_ships          Actual ship calculations
# max                  return max of 2 numbers
# min                  return min of 2 numbers
# round                standard round
# getline              stub for &main'getline
# tools_foreach        issue a command for an AREA of sectors
# resolve              evaluate variables in foreach command
# resolve              evaluate variables in foreach command
# tools_prod_delta     compute production delta for a country
# tools_food_delta     estimate civ/uw/food production
# tools_warehouse_delta estimate deltas for dist centers
# prod_warn            used in tools_*_delta
# in_realm             return 1 if sect in a realm
# tools_status         show sector info from DB
# tools_lstat          show land info from DB
# tools_pstat          show plane info from DB
# tools_sstat          show ship info from DB
# makerealm            return all sectors in a realm (used in stat)

#       --- Main ---

&buildcost_init;	# initialize buildcost variables
&comm_init;		# initialize commodity variables
&xmvr_init;		# initialize xmvr variables

#       --- Initialization ---

# You may wish to change some of the variables in xmvr_init.
# The variables in this subroutine are used by xmvr.
sub xmvr_init {
  local ($des, $comm);

  # The associative array $minmob{$des} specifies the minimum amount
  # of mobility we want left in a sector after moving stuff out.
  $minmob{'w'} = 60;
  $minmob{'e'} = 80;		# need to move mil out of enlistment centres
  # b,l,t,r,p,) don't need to have much mob...
  $minmob{'b'} = 20;
  $minmob{'l'} = 20;
  $minmob{'t'} = 20;
  $minmob{'r'} = 20;
  $minmob{'p'} = 20;
  $minmob{')'} = 0;
  # Set $minmob to 40 for all other sector types:
  foreach $des (@desig) {
    $minmob{$des} = 40 unless defined($minmob{$des});
  }

  foreach $comm (@commo) {
    $main'functionmap{$comm.'mvr'} = "&tools_xmvr('$comm')"; #'
  }
}

# Initialize commodity variables
sub comm_init {
  # Sector designations
  @desig = ('-', '^', 'c', 'p', '+', ')', '#', '=',
	    'd', 'i', 'm', 'g', 'h', 'w', 'u', '*', 'a', 'o', 'j', 'k', '%',
	    't', 'f', 'r', 'n', 'l', 'e', '!', 'b');

  # Commodities.
  @commo = ('c', 'm', 'u', 'f',
	    's', 'g', 'p', 'i', 'd', 'b', 'o', 'l', 'h', 'r');

  # Commodity weights and warehouse packing factors.
  $weight{'civ'} = 1;    $packing{'civ'} = 4;
  $weight{'mil'} = 1;    $packing{'mil'} = 1;
  $weight{'uw'} = 2;     $packing{'uw'} = 2;
  $weight{'food'} = 1;   $packing{'food'} = 10;
  $weight{'shell'} = 1;  $packing{'shell'} = 10;
  $weight{'gun'} = 10;   $packing{'gun'} = 10;
  $weight{'pet'} = 1;    $packing{'pet'} = 10;
  $weight{'iron'} = 1;   $packing{'iron'} = 10;
  $weight{'dust'} = 5;   $packing{'dust'} = 10;
  $weight{'bar'} = 50;   $packing{'bar'} = 5;
  $weight{'oil'} = 1;    $packing{'oil'} = 10;
  $weight{'lcm'} = 1;    $packing{'lcm'} = 10;
  $weight{'hcm'} = 1;    $packing{'hcm'} = 10;
  $weight{'rad'} = 8;    $packing{'rad'} = 10;
  
  # Commodity strings
  $commstr{'c'} = 'civ';
  $commstr{'m'} = 'mil';
  $commstr{'u'} = 'uw';
  $commstr{'f'} = 'food';
  $commstr{'s'} = 'shell';
  $commstr{'g'} = 'gun';
  $commstr{'p'} = 'pet';
  $commstr{'i'} = 'iron';
  $commstr{'d'} = 'dust';
  $commstr{'b'} = 'bar';
  $commstr{'o'} = 'oil';
  $commstr{'l'} = 'lcm';
  $commstr{'h'} = 'hcm';
  $commstr{'r'} = 'rad';
}

sub buildcost_init {
  # x and y direction vectors.
  $xdir{'j'}=2; 	$ydir{'j'}=0;
  $xdir{'u'}=1; 	$ydir{'u'}=-1;
  $xdir{'y'}=-1;	$ydir{'y'}=-1;
  $xdir{'g'}=-2;	$ydir{'g'}=0;
  $xdir{'b'}=-1;	$ydir{'b'}=1;
  $xdir{'n'}=1; 	$ydir{'n'}=1;
  
  # Directions.
  @dirstr = ( 'j', 'u', 'y', 'g', 'b', 'n' );
  
  # Maximum path lengths (to prevent long loops).  $maxpath MUST be positive.
  $maxpath=999;
}

#       --- Buildcost ---

# The following functions are used by the "buildcost" subroutine which
# calculates pathcosts from a sector to nearby sectors.

# Print a command and then send it to the server.
sub send {
  local ($line) = @_;

  if ($main'terse) { #'
    print main'UNTERSEOUT '.'; #'
  } else {
    print $line."\n";
  }
  &main'singlecommand($line); #'
}

# If co-ordinates wrap around the edge of the world, modify the co-ordinates.
sub wrap {
  local ($x,$y) = @_;
  $x -= $width if ($x >= $width/2);
  $x += $width if ($x < -$width/2);
  $y -= $height if ($y >= $height/2);
  $y += $height if ($y < -$height/2);
  ($x,$y);
}

# Returns an array of the six sectors adjacent to the argument $sect.
sub adjacent {
  local ($sect) = pop(@_);
  local (@adjacent,$x,$y,$ax,$ay,$dir);
  
  ($x,$y) = split(',', $sect);
  foreach $dir (@dirstr) {
    ($ax,$ay) = &wrap($x+$xdir{$dir}, $y+$ydir{$dir});
    push(@adjacent, $ax.','.$ay);
  }
  @adjacent;
}

# Cost to move into a sector.
# Uses $movcost{des} loaded from show sector stats.
sub movcost {
  local($sect) = @_;
  local($des, $c);

  $des = $dump{$sect,'des'};
  $des = $bdes{$sect} unless $des;
  if ($des eq '\.') { return 1e9; }	# to keep us from moving through the sea
  $c = (100*$movcost{$des} - $dump{$sect,'eff'})*0.002;
  $c = 1e9 if $c < 0;
  $c = 0.01 if $c < 0.01;
  $c;
}

# buildcost calculates how much mobility it costs to move into a dest sector
# from path-connected sectors.  Each time it is called, the array of
# sectors connected by a path to the dest sector grows to include certain
# adjacent sectors.  It is like an exploding disk, increasing in diameter
# with each call to buildcost.  It explodes along the cheapest path, with
# each expanding ring having the same path cost to the dest sector.
# The costs to move into the dist sector from the path-connected sectors
# is contained in the associative array %cost.  The associative array %marked,
# contains those sectors of %cost which have the cheapest pathcost.
# buildcost returns the number of sectors added to the %cost array.
# If used in an array context, it returns the added sectors.
sub buildcost {
  local(*cost, *marked) = @_;
  local (@added, $sect, $cost, $newsect, $mincost);
  
  @added=();
  do {
    $mincost = 1e9;
  
    # Find the minimum pathcost to move into unmarked sectors.
    foreach $sect (keys %cost) {
      if ($cost{$sect} < $mincost && !(defined $marked{$sect})) {
	$mincost = $cost{$sect};
      }
    }
    last if $mincost == 1e9;
  
    # For each sector with minimum pathcost.
    while (($sect,$cost) = each %cost) {
      next if $cost != $mincost;
      $marked{$sect} = 1;		# mark the sector

      # find pathcost to all owned adjacent sectors not already in %cost
      foreach $newsect (&adjacent($sect)) {
	next if (defined($cost{$newsect}) || $own{$newsect} != $coun);
	$cost{$newsect} = $cost + &movcost($newsect);
	push (@added, $newsect);
      }
    }
  } while (!@added);
  @added;
}

#       --- Nova ---

# return a list of all unowned wilderness sectors adjacent to my sectors
sub border_sectors {
  local ($asect, $sect, $own);
  local (%border_sectors);
  
  while (($sect,$own) = each %own) {
    next if $own != $coun;
    foreach $asect (&adjacent($sect)) {
      if (!$own{$asect} && $bdes{$asect} eq '-') {
	$border_sectors{$asect} = 1;
      }
    }
  }
  keys %border_sectors;
}

# Find the cheapest path from $from to $to.  We cannot use "bestpath" because
# we might not own the destination sector.
sub makepath {
  local($from, $to, *cost) = @_;
  local($newsect,$path,$sect,$dir,$x,$y,$ax,$ay,$found);
  
  return '' unless defined $cost{$to};

  $sect = $from;
  $path = '';
  while ($sect ne $to) {
    ($x,$y) = split(',', $sect);
    $found = 0;
    foreach $dir (@dirstr) {
      ($ax,$ay) = &wrap($x+$xdir{$dir}, $y+$ydir{$dir});
      $newsect = $ax . ',' . $ay;
      if (defined($cost{$newsect}) && $cost{$newsect} < $cost{$sect}) {
	$path .= $dir;
	$found = 1;
	last;
      }
    }
    if ($found) {
      $sect = $newsect;
    } else {
      warn "Failed to find path from $from to $to at $sect\n";
      print STDERR %path;
      return '';
    }
  }
  $path;
}

sub nova {
  local ($dest,$sect,$des,$comm,%cost,%marked,@added,$success);
  
  foreach $dest (&border_sectors) {
    last if $main'status; #'
    undef %cost;
    undef %marked;
    $cost{$dest} = &movcost($dest);
  explore:
    while (@added = &buildcost(*cost,*marked)) {
      foreach $sect (@added) {
        last explore if $main'status; #'
	next if ($dump{$sect,'mob'} <= 2*$cost{$sect} ||
		 $oldown{$sect} != $coun);
	if ($dump{$sect,"civ"} > 1) {
	  $comm = 'c';
	} elsif ($dump{$sect,"mil"} > 1) {
	  $comm = 'm';
	} else {
	  next;
	}
	print "explore $comm $sect 1 ".
	  &makepath($sect,$dest,*cost)."h\n";
	print $main'S "explore $comm $sect 1 ". #'
	  &makepath($sect,$dest,*cost)."h\n";
	&main'slurp; #'
	if ($main'mode eq '4') {
	  $own{$dest}=-1;
	  print "$_\n";
	  print $main'S "\n"; #'
	  &main'slurp; #'
	} else {
	  $dump{$sect, $commstr{$comm}}--;
	  $dump{$dest, $commstr{$comm}}++;
	  $own{$dest} = $coun;
	  $success = 1;
	}
	last explore;
      }
    }
  }
  &send("des * ?des=- +");
  $success;
}

# Keep calling nova until there is no place else to expand to.
# Argument is the realm to explore.
$main'functionmap{'nova'} = '&tools_supernova'; #'
sub tools_supernova {
  local ($realm) = $main'commandarg; #'
  $realm = '#' unless $realm;
    
  &print_n_parse('dump *');
  &send("map $realm");

  while (&nova && !$main'status) { #'
    &print_n_parse('dump *');
    &send("map $realm");
  }
}

#       --- xmvr ---

# This function moves a commodity from $from to $to.
sub do_move {
  local ($from, $to, $des, $comm, $pathcost, *rich, *poor) = @_;
  local ($amount, $mobcost, $packing);

  if ($des eq 'w' &&
      $dump{$from,'eff'} >= 60) {
    $packing = $packing{$cs};
  } elsif ($des eq 'b' &&
	   $comm eq 'b' &&
	   $dump{$from,'eff'} >= 60) {
    $packing = 4;
  } else {
    $packing = 1;
  }
  $amount = $rich{$from};
  $amount = $poor{$to} if $rich{$from} > $poor{$to};
  $mobcost = $weight{$cs} * $pathcost / $packing;
  if ($dump{$from,'mob'} - $amount * $mobcost < $minmob{$des}) {
    $amount = int(($dump{$from,'mob'} - $minmob{$des})/$mobcost);
    $rich{$from} = 0;
  }
  if ($amount > 0) {
#   print "expected best path: " . &makepath($from, $to, *cost) . "h\n";
#   printf "expected movement cost: %.3f\n", $pathcost;
#   print "expected total movement cost: " . $mobcost * $amount . "\n";
    &send("move $comm $from $amount $to");

    $dump{$from,$cs} -= $amount;
    $rich{$from} -= $amount;
    $rich{$from} = 0 if $rich{$from} < 0;

    $dump{$to,$cs} += $amount;
    $poor{$to} -= $amount;
    $poor{$to} = 0 if $poor{$to} < 0;
  }
}

# &tools_xmvr($comm) moves commodities from rich sectors to poor sectors.
# If $comm is 'c' or 'u', then $maxciv and $maxuw are used to determine
# the desired number of civs or uw's in each sector.  Otherwise,
# $dump{$sect,$comm.'_dist'} is used.  xmvr does not reduce the mobility of any
# sector below $minmob{$des}.  It does not move out of or into conquered
# sectors.  It does not move civs or uws out of or into sectors with < 100%
# work.  It never moves into a mountain.  100% efficient sectors with
# Civs and uws are never moved out of a warehouse.
sub tools_xmvr {
  local ($comm) = @_;
  local ($cs) = $commstr{$comm};
  local ($sect, $extra, $des);
  local (%rich, %poor, $total);
  local (%marked, %cost);
  local ($icount, @added);
  local ($from, $to);
  local ($rehash) = 1;
  local ($found_poor, $found_rich);
  local (@poor, @rich);
  local($realm,$switches,$th,$area);

  ($realm, $switches, $th) = ($main'commandarg =~
    /^([#*]\d{0,2})\s*(\?\S+)?\s*(\d*)$/);
  
  $area = $realm if $realm;
  $area .= " $switches" if $switches;
  $area = '*' unless $area;
  &build_sect_target($area);
  &print_n_parse("dump *") unless $area eq '*';
  if (!$th) {
      $th = $maxciv if $comm eq 'c';
      $th = $maxuw if $comm eq 'u';
  }

  if ($comm eq 'c' || $comm eq 'u') {
    foreach $sect (keys %own) {
      next if (!$target{$sect} ||
               $own{$sect} != $coun ||     # we do not own sector
	       $oldown{$sect} != $coun ||  # we are not oldowner of sector
	       $dump{$sect,'work'} < 100); # do not move unhappy workers
      next if $dump{$sect,$cs} == $th;  # has right amount
      $extra = $dump{$sect,$cs} - $th;
      if ($extra > 0) {
	# Don't move civs or uw's out if not enough mob or if is a warehouse.
	next if ($dump{$sect,'mob'} <= $minmob{$dump{$sect,'des'}} ||
		 $dump{$sect,'des'} eq 'w');
	$rich{$sect} = $extra;
      } elsif ($extra < 0) {
	# Never move into a mountain.
	next if ($dump{$sect,'des'} eq '^');
	$poor{$sect} = -$extra;
      }
    }
  } else {
    foreach $sect (keys %own) {
      $th = $dump{$sect,$comm.'_dist'};
      next if (!$target{$sect} ||
               $dump{$sect,$cs} == $th ||
	       $own{$sect} != $coun ||
	       ($oldown{$sect} != $coun && $dump{$sect,$cs} < $th));
      $extra = $dump{$sect,$cs} - $th;
      if ($extra > 0) {
	# Don't move out if not enough mobility.
	next if ($dump{$sect,'mob'} <= $minmob{$dump{$sect,'des'}});
	$rich{$sect} = $extra;
      } elsif ($extra < 0) {
	# Never move into a mountain.
	next if ($dump{$sect,'des'} eq '^');      
	$poor{$sect} = -$extra;
      }
    }
  }

 xmvrloop:
  while ($rehash && !$main'status) { #'
    if ($rehash == 2) { # Clean out all the sectors which have done their thing
      foreach $sect (@poor) {
	delete $poor{$sect} unless $poor{$sect};
      }
      foreach $sect (@rich) {
	delete $rich{$sect} unless $rich{$sect};
      }
    }
    @poor = keys %poor;
    @rich = keys %rich;
    $rehash = 0;
    if (!@poor) {
      print "No poor sectors.\n";
    } elsif (!@rich) {
      print "No rich sectors.\n";
    } elsif (@poor >= @rich) {
      print "Poor in $cs.  Looping on rich sectors...\n";
    loop_on_rich:
      foreach $from (@rich) {
	undef %marked;
	undef %cost;
	$cost{$from} = 0;
	$icount = 0;
	$found_poor = 0;
	$des = $dump{$from,'des'};
	while ($icount++ < $maxpath &&
	       $rich{$from} &&
	       (@added = &buildcost(*cost, *marked))) {
	  foreach $to (@added) {
	    next unless $poor{$to};
	    $found_poor = 1;
            last xmvrloop if $main'status; #'
	    &do_move($from, $to, $des, $comm, $cost{$to}, *rich, *poor);
	  }
	}
	if (!$found_poor) {	# No more poor on this island.
	  foreach $sect (keys %cost) {
	    delete $rich{$sect};
	  }
	  $rehash = 2;
	  print "\nSkipping island...\n";
	  last loop_on_rich;
	}
      }
    } else {
      print "Rich in $cs.  Looping on poor sectors...\n";
    loop_on_poor:
      foreach $to (@poor) {
	undef %marked;
	undef %cost;
	$cost{$to} = 0;
	$icount = 0;
	$found_rich = 0;
	while ($icount++ < $maxpath &&
	       $poor{$to} &&
	       (@added = &buildcost(*cost, *marked))) {
	  foreach $from (@added) {
	    next unless $rich{$from};
	    $found_rich = 1;
            last xmvrloop if $main'status; #'
	    &do_move($from, $to, $dump{$from,'des'}, $comm,
			   $cost{$from}, *rich, *poor);
	  }
	}
	if (!$found_rich) {	# No more rich on this island
	  foreach $sect (keys %cost) {
	    delete $poor{$sect};
	  }
	  $rehash = 2;
	  print "\nSkipping island...\n";
	  last loop_on_poor;
	}
      }
    }
  }
}

#      --- Router ---

# Return a list of sectors which have des '+', 'g', or 'o', and have less
# than 8 gold and ocon.
sub useless {
  local ($sect,$des,@useless);

  foreach $sect (keys %own) {
    next if $dump{$sect,'sdes'} ne '_';
    $des = $dump{$sect,'des'};
    if ($des eq '+' || $des eq 'g' || $des eq 'o') {
      if ($dump{$sect,'gold'} < 8 && $dump{$sect,'ocontent'} < 8) {
	push(@useless,$sect);
      }
    }
  }
  @useless;
}

# Find the nearest warehouse and dist to it.  If a warehouse can not be
# found within 10 sectors, find a useless sector, des it 'w', and dist to it.
$main'functionmap{'router'} = '&tools_router'; #'
sub tools_router {
  local ($dsect,$sect,%cost,%marked,$gotsect,$gotwarehouse,@useless,$dist);
  
  &build_sect_target($main'commandarg);

  @useless=&useless;
 routerloop:
  foreach $sect (keys %own) {	
    last routerloop if $main'status; #'
		next if !$target{$sect} ||
		$own{$sect} != $coun ||
		$dump{$sect,"des"} eq 'w' ||
		$dump{$sect,"sdes"} eq 'w';
    undef %cost;
    undef %marked;
    $cost{$sect}=0;
    $gotwarehouse = 0;
    $gotsect='';
    $dist=0;
  buildcost:
    while (($dist++)<$maxpath && (@added = &buildcost(*cost,*marked))) {
      foreach $dsect (@added) {
	last routerloop if $main'status; #'
	if ($dump{$dsect,"des"} eq 'w' ||
	    $dump{$dsect,"sdes"} eq 'w') {
	    $gotwarehouse=1;
	  if ($dsect ne $dump{$sect,"dist_x"}.','.$dump{$sect,"dist_y"}) {
	    &send("dist $sect $dsect");
	    $gotsect=$dsect;
	    last buildcost;
	  }
	}
      }
    }
    if (!$gotsect) {		# did not find a warehouse
      if (!$gotwarehouse) {
	# Find the closest useless sector.
	foreach $dsect (@useless) {
	  if (defined($cost{$dsect})) {
	    if (!($gotsect) ||
		($cost{$dsect} < $cost{$gotsect})) {
	      $gotsect=$dsect;
	    }
	  }
	}
	if ($gotsect) {
	  &send("des $gotsect w");
	  &send("dist $sect $gotsect");
	  $dump{$gotsect,"sdes"}='w';
	  $newdes{$gotsect}='w';
	} else {
          print "Can't find a warehouse for $sect to dist to.\n";
        }
      }
    }
  }
}

#      --- Setfood ---

# This function sets your food thresholds for maximum civ growth.  It will
# never lower any existing food thresholds, and it doesn't set food thresholds
# in warehouses.
$main'functionmap{'setfood'} = '&tools_setfood'; #'
sub tools_setfood {
  local ($sect, $th);
  local ($realm, $switches, $area, $num);
  local ($i, $civ, $uw, $mil);

  if (!$eatrate) {
    print "No food is required in this game.\n";
    return;
  }
  if ($main'commandarg =~ /^([#*]\d{0,2}|\d+,\d+)\s*(\?\S+)?\s*(\d*)$/) { #'
      ($realm,$switches,$num) = ($main'commandarg =~ #'
				 /^([#*]\d{0,2}|\d+,\d+)\s*(\?\S+)?\s*(\d*)$/);
  } elsif ($main'commandarg =~ /^\d+$/) {
    $num = $main'commandarg;
  }
  $area = $realm if $realm;
  $area .= " $switches" if $switches;
  $area = '*' unless $area;
  &build_sect_target($area);
  $num = 1 unless $num;
  print "\nSetting food thresholds for $num updates...\n" if $num > 1;

  foreach $sect (keys %own) {
    last if $main'status; #'
    next if !$target{$sect} || $dump{$sect,'des'} eq 'w';	
    $civ = $dump{$sect,'civ'};
    $uw = $dump{$sect,'uw'};
    $mil = $dump{$sect,'mil'};
    for $i (2..$num) {
      $civ += $civ*$obrate*$etu;
      $uw += $uw*$uwbrate*$etu;
    }
    # only capitols grow 1k+ civs
    if ($civ > 999) {         # better than no limit..
      $civ = 999 unless $dump{$sect,'des'} eq 'c' &&
          defined($option{'BIG_CITY'});
    }
    if ($uw > 999) { $uw = 999; }
    # compute food threshold that will feed the projected number of
    # civs in $num updates, assuming food will be distributed to
    # sector every update (09/03/95 lorphos@empire.net)
    $th = int($num + $etu * ($eatrate * ($civ + $uw + $mil))
      + 2 * $babyeat * ($civ*$obrate + $uw*$uwbrate));
    &send("th f $sect $th") if $th > $dump{$sect,'f_dist'} && $th > 1;
  }
}

#      --- External Functions ---

# Find my country number.

sub main'find_country_number { #'
  undef $coun;
  &print_n_parse('nation');
  $main'nstatus = $nstatus;
  if ($new_server) {
    print "Cool!  You're using the new server!\n";
  } else {
    &print_n_parse("change c $main'country"); #'
  }
  if (!defined($coun)) {
    print STDERR "You didn't have enough BTU's to get your country number.\n";
    print STDERR "What is your country number? ";
    $coun = <STDIN>;
    chop $coun;
  }
  $main'coun = $coun; #'
  $number{$main'country} = $coun;
  print "Your country number is $coun.\n";
}

sub main'tools_init { #'
  &print_n_parse('show sector stats');
  return if $main'status;
  &print_n_parse('show ship build');
  return if $main'status;
  &print_n_parse('show ship capabilities');
  return if $main'status;
  &print_n_parse('show ship stats');
  return if $main'status;
  &print_n_parse('show plane build');
  return if $main'status;
  &print_n_parse('show land build');
  return if $main'status;
  &print_n_parse('show land stats');
  return if $main'status;
  &print_n_parse('version');
  return if $main'status;
  &print_n_parse('relations');
  return if $main'status;
  &letter_init;
  $country = $main'country; #'
  $coun = $main'coun; #'
  $btus = $main'btus; #'
  $timeused = $main'timeused;   #'
}

$main'functionmap{'lneweff'} = '&tools_landeff'; #'

sub tools_landeff {
  local(@u, %units, %mil, %lcm, %hcm, %gun, %shell, %unituse, %unitneed, $unit, $xy, $x, $y, $out, $area);

  $area = $main'commandarg; #'
  $area = '*' unless $area;
 
  print STDERR "parsing land $area...";
  print $main'S "land $area\n"; #'
  $main'command="land"; #'
  while(&getline()) {
    if (/%/) {
      ($unit) = /^\s*(\d+)\s+/;
      $units{$unitsect{$unit}}.="$unit ";
    }
  }
  print STDERR "done\n";

  print "\n Unit Type            x,y   Eff  Mil      Lcm    Hcm    Gun    Shell Avail Maint\n";
  foreach $xy (keys %units) {
    print $main'S "dump $xy\n"; #'
    $main'command="dump"; #'
    while(&getline()) { 1; }
    next if $dump{$xy, 'des'} ne '!' && $dump{$xy, 'des'} ne 'f';
    ($mil{$xy}, $lcm{$xy}, $hcm{$xy}, $gun{$xy}, $shell{$xy})=&build_units($xy);
    @u=split(/ /, $units{$xy});
    ($x, $y)=($xy=~/(\S+),(\S+)/);

    while($#u>-1) {
      $unit=shift(@u);
      printf "#%-4d %-13s%4d,%-4d%3d%% %3d%-5s %2d%-4s %2d%-4s %2d%-4s %2d%-4s %-4s \$%-4d\n", $unit, $unitname{$unit}, $x, $y, $neweff{$unit}, $unituse{$unit, 'mil'}, $unitneed{$unit, 'mil'}, $unituse{$unit, 'lcm'}, $unitneed{$unit, 'lcm'}, $unituse{$unit, 'hcm'}, $unitneed{$unit, 'hcm'}, $unituse{$unit, 'gun'}, $unitneed{$unit, 'gun'}, $unituse{$unit, 'shell'}, $unitneed{$unit, 'shell'}, $unitneed{$unit, 'avail'}, $unitmaint{$unit};
    }
    printf "--- total ---      %4d,%-4d     %3d     %3d    %3d    %3d    %3d    %3d\n",
    $x,$y,
    $mil{$xy} <= 0?$dump{$xy, 'mil'}:($dump{$xy, 'mil'} - $mil{$xy}),
    $lcm{$xy} <= 0?$dump{$xy, 'lcm'}:($dump{$xy, 'lcm'} - $lcm{$xy}),
    $hcm{$xy} <= 0?$dump{$xy, 'hcm'}:($dump{$xy, 'hcm'} - $hcm{$xy}),
    $gun{$xy} <= 0?$dump{$xy, 'gun'}:($dump{$xy, 'gun'} - $gun{$xy}),
    $shell{$xy} <= 0?$dump{$xy, 'shell'}:($dump{$xy, 'shell'} - $shell{$xy}),
    $avail{$xy} <= 0?$dump{$xy, 'avail'}:($dump{$xy, 'avail'} - $avail{$xy});
    printf "--- need/+extra -- %4d,%-4d  %6s  %6s %6s %6s %6s %6s\n",
    $x,$y,
    $mil{$xy} == 0?'-':($mil{$xy} < 0?-$mil{$xy}:('+'.$mil{$xy})),
    $lcm{$xy} == 0?'-':($lcm{$xy} < 0?-$lcm{$xy}:('+'.$lcm{$xy})),
    $hcm{$xy} == 0?'-':($hcm{$xy} < 0?-$hcm{$xy}:('+'.$hcm{$xy})),
    $gun{$xy} == 0?'-':($gun{$xy} < 0?-$gun{$xy}:('+'.$gun{$xy})),
    $shell{$xy} == 0?'-':($shell{$xy} < 0?-$shell{$xy}:('+'.$shell{$xy})),
    $avail{$xy} == 0?'-':($avail{$xy} < 0?-$avail{$xy}:('+'.$avail{$xy}));
  }

  foreach $xy (keys %units) {
    if ($dump{$xy, 'off'}==1) { print "Sector $xy is turned off!\n"; }
    $out="Sector $xy needs";
    if ($mil{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $mil{$xy}*-1) , "mil"); }
    if ($lcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $lcm{$xy}*-1) , "lcm"); }
    if ($hcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $hcm{$xy}*-1) , "hcm"); }
    if ($gun{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $gun{$xy}*-1) , "gun"); }
    if ($shell{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $shell{$xy}*-1) , "shell"); }
    if (substr($out,length($out)-1,1) cmp "s") { print "$out\n"; }
  }
}

sub build_units {
  local($maint, $avail, $wp_eff, $delta, $left, $leftp, $mneed, $lneed, $hneed, $gneed, $sneed, $optbuild, $amneed, $alneed, $ahneed, $agneed, $asneed , $mult, $build, $buildp, $unit, $type);
  local(@units, %mil, %lcm, %hcm, %gun, %shell);

  local($xy)=@_;
  local(@units)=split(/ /, $units{$xy});

  $avail{$xy}=$dump{$xy, 'avail'}; $mil{$xy}=$dump{$xy, 'mil'};
  $lcm{$xy}=$dump{$xy, 'lcm'}; $hcm{$xy}=$dump{$xy, 'hcm'};
  $gun{$xy}=$dump{$xy, 'gun'}; $shell{$xy}=$dump{$xy, 'shell'};

  while($#units>-1) {
    $unit=shift(@units);
    $type=$unitname{$unit};
    if ($tech{$coun}<$landtech{$unit}*0.85) { $mult=2; }
    else { $mult=1; }
    $maint=($mult*$etu*.001*$buildcost{$type})+($etu*$buildmil{$type}*$uniteff{$unit}/100*$milcost);
    $avail=$avail{$xy}*100; $eff{$unit}=$uniteff{$unit};
    $wp_eff=20+($buildlcm{$type}+2*$buildhcm{$type});
    $delta=$avail/$wp_eff;
    if ($delta>$uniteff) { $delta=$uniteff; }
    $left=100-$uniteff{$unit};
    $optbuild=&min($left, $uniteff);
    if ($left>$delta) { $left=$delta; }
    $build=0;
    if ($left>0 && ($dump{$xy, "off"}==0)) {
      $leftp=$left/100;
      $mneed=&round($buildmil{$type}*$leftp);
      $lneed=&round($buildlcm{$type}*$leftp);
      $hneed=&round($buildhcm{$type}*$leftp);
      $gneed=&round($buildgun{$type}*$leftp);
      $sneed=&round($buildshell{$type}*$leftp);
      if ($mil{$xy}>=$mneed) { $buildp=$leftp; }
      else { $buildp=$mil{$xy}/$buildmil{$type}; }
      if ($lcm{$xy}<$lneed) {
	$buildp=&min($buildp, $lcm{$xy}/$buildlcm{$type});
      }
      if ($hcm{$xy}<$hneed) {
	$buildp=&min($buildp, $hcm{$xy}/$buildhcm{$type});
      }
      if ($buildgun{$type}!=0 && $gun{$xy}<$gneed) {
	$buildp=&min($buildp, $gun{$xy}/$buildgun{$type});
      }
      if ($buildshell{$type}!=0 && $shell{$xy}<$sneed) {
	$buildp=&min($buildp, $shell{$xy}/$buildshell{$type});
      }
      if ($buildp<0) { $buildp=0; }
      $amneed=&round($buildmil{$type}*$buildp);
      $alneed=&round($buildlcm{$type}*$buildp);
      $ahneed=&round($buildhcm{$type}*$buildp);
      $agneed=&round($buildgun{$type}*$buildp);
      $asneed=&round($buildshell{$type}*$buildp);
      $mil{$xy}-=$mneed;
      $lcm{$xy}-=$lneed;
      $hcm{$xy}-=$hneed;
      $gun{$xy}-=$gneed;
      $shell{$xy}-=$sneed;
      if ($dump{$xy, 'des'} cmp '!' && $dump{$xy, 'des'} cmp 'f') {
        $buildp/=3; $optbuild/=3;
      }
      $build=$buildp*100;
      $avail=$avail/100-&round($build*$wp_eff/100);
      $avail{$xy}=$avail;
      $unituse{$unit, 'avail'}=&round($build*$wp_eff/100);
      $neweff{$unit}=$eff{$unit}+$build;
      $maint=&round($maint+$mult*$buildcost{$type}*$build/100);
      $unituse{$unit, 'mil'}=$amneed;
      $unituse{$unit, 'lcm'}=$alneed;
      $unituse{$unit, 'hcm'}=$ahneed;
      $unituse{$unit, 'gun'}=$agneed;
      $unituse{$unit, 'shell'}=$asneed;
      if ($avail{$xy}<=0 && $eff{$unit}<100) { 
        $unitneed{$unit, 'avail'}="(".int(($optbuild-$build)*$wp_eff/100).")";
      }
      if ($mneed>$amneed && $mil{$xy}<$mneed) {
	if ($mil{$xy}>-1*$mneed) {
	  $unitneed{$unit, 'mil'}="(".-1*$mil{$xy}.")";
	} else {
	  $unitneed{$unit, 'mil'}="(".$mneed.")";
	}
      }
      if ($lneed>$alneed && $lcm{$xy}<$lneed) { 
        if ($lcm{$xy}>-1*$lneed) {
          $unitneed{$unit, 'lcm'}="(".-1*$lcm{$xy}.")";
        } else {
          $unitneed{$unit, 'lcm'}="(".$lneed.")";
        }
      }
      if ($hneed>$ahneed && $hcm{$xy}<$hneed) { 
        if ($hcm{$xy}>-1*$hneed) {
          $unitneed{$unit, 'hcm'}="(".-1*$hcm{$xy}.")";
        } else {
          $unitneed{$unit, 'hcm'}="(".$hneed.")";
        }
      }
      if ($gneed>$agneed && $gun{$xy}<$gneed) { 
        if ($gun{$xy}>-1*$gneed) {
          $unitneed{$unit, 'gun'}="(".-1*$gun{$xy}.")";
        } else {
          $unitneed{$unit, 'gun'}="(".$gneed.")";
        }
      }
      if ($sneed>$asneed && $shell{$xy}<$sneed) { 
        if ($shell{$xy}>-1*$sneed) {
          $unitneed{$unit, 'shell'}="(".-1*$shell{$xy}.")";
        } else {
          $unitneed{$unit, 'shell'}="(".$sneed.")";
        }
      }
    } else {
      $neweff{$unit}=$uniteff{$unit};
      if ($optbuild!=0) { 
        $unitneed{$unit, 'avail'}="(".int($optbuild*$wp_eff/100).")";
      }
    }
    $unitneed{$unit, 'avail'}=$unituse{$unit, 'avail'} unless $unitneed{$unit, 'avail'};
    $unitmaint{$unit}=int($maint);
  }
  return $mil{$xy}, $lcm{$xy}, $hcm{$xy}, $gun{$xy}, $shell{$xy};
}
 
$main'functionmap{'pneweff'} = '&tools_planeeff'; #'

sub tools_planeeff {
 
local(@p, %planes, %mil, %lcm, %hcm, %planeuse, %planeneed, %unit, $x, $y, $out, $area);

  $area = $main'commandarg; #'
  $area = "*" unless $area;

  print STDERR "parsing plane $area...";
  $main'command="plane"; #'
  print $main'S "plane $area\n"; #'
  while(&getline()) {
    if (/%/) {
      ($unit)=/^\s*(\d+)\s+/;
      $planes{$planesect{$unit}}.="$unit ";
    }
  }
  print STDERR "done\n";
  print "\nPlane Type                   x,y    Eff  Mil    Lcm    Hcm    Avail  Maint\n";
  foreach $xy (keys %planes) {
    print $main'S "dump $xy\n"; #'
    $main'command="dump"; #'
    while(&getline()) { 1; }
    ($mil{$xy}, $lcm{$xy}, $hcm{$xy})=&build_planes($xy);
    @p=split(/ /, $planes{$xy});
    ($x, $y)=($xy=~/(\S+),(\S+)/);
    while($#p>-1) {
      $unit=shift(@p);
      printf "#%-4d %-20s%4d,%-4d%3d%% %3d%-5s %2d%-4s %2d%-4s %-5s \$%-4d\n", $unit, substr($planename{$unit},0,20), $x, $y, $neweff{$unit}, $planeuse{$unit, 'mil'}, $planeneed{$unit, 'mil'}, $planeuse{$unit, 'lcm'}, $planeneed{$unit, 'lcm'}, $planeuse{$unit, 'hcm'}, $planeneed{$unit, 'hcm'}, $planeneed{$unit, 'avail'}, $planemaint{$unit};
    }
    printf "--- total ---             %4d,%-4d     %3d     %3d    %3d    %3d\n",
    $x,$y,
    $mil{$xy} <= 0?$dump{$xy, 'mil'}:($dump{$xy, 'mil'} - $mil{$xy}),
    $lcm{$xy} <= 0?$dump{$xy, 'lcm'}:($dump{$xy, 'lcm'} - $lcm{$xy}),
    $hcm{$xy} <= 0?$dump{$xy, 'hcm'}:($dump{$xy, 'hcm'} - $hcm{$xy}),
    $avail{$xy} <= 0?$dump{$xy, 'avail'}:($dump{$xy, 'avail'} - $avail{$xy});
    printf "--- need/+extra --        %4d,%-4d  %6s  %6s %6s %6s %6s %6s\n",
    $x,$y,
    $mil{$xy} == 0?'-':($mil{$xy} < 0?-$mil{$xy}:('+'.$mil{$xy})),
    $lcm{$xy} == 0?'-':($lcm{$xy} < 0?-$lcm{$xy}:('+'.$lcm{$xy})),
    $hcm{$xy} == 0?'-':($hcm{$xy} < 0?-$hcm{$xy}:('+'.$hcm{$xy})),
    $avail{$xy} == 0?'-':($avail{$xy} < 0?-$avail{$xy}:('+'.$avail{$xy}));
  }
  foreach $xy (keys %planes) {
    if ($dump{$xy, 'off'}==1) { print "Sector $xy is turned off!\n"; }
    $out="Sector $xy needs";
    if ($mil{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $mil{$xy}*-1) , "mil"); }
    if ($lcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $lcm{$xy}*-1) , "lcm"); }
    if ($hcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $hcm{$xy}*-1) , "hcm"); }
    if (substr($out,length($out)-1,1) cmp "s") { print "$out\n"; }
  }
}

sub build_planes {
  local($maint, $avail, $wp_eff, $delta, $left, $leftp, $mneed, $lneed, $hneed, $amneed, $alneed, $ahneed, $optbuild, $mult);
  local(@units, %mil, %lcm, %hcm, %eff);

  local($xy)=@_;
  local(@units)=split(/ /, $planes{$xy});

  $avail{$xy}=$dump{$xy, 'avail'}; $mil{$xy}=$dump{$xy, 'mil'};
  $lcm{$xy}=$dump{$xy, 'lcm'}; $hcm{$xy}=$dump{$xy, 'hcm'};
  if ($planesln{$unit}=~/^(\d+)S/) {
    $main'command="ship"; #'
    local($ship)=$1;
    print $main'S "ship $ship\n"; #'
    while(&getline()) { 1; }
    $avail{$ship}=$etu*$shipcargo{$ship, "mil"}/2;
  }

  while($#units>-1) {
    ($unit)=shift(@units);
    $type=$planename{$unit};
    if ($tech{$coun}<$planetech{$unit}*0.85) { $mult=2; }
    else { $mult=1; }
    $maint=($mult*$etu*.001*$buildcost{$type})+($etu*$buildmil{$type}*$milcost*5);
    $avail=$avail{$xy}*100; $eff{$unit}=$planeeff{$unit};
    if ($planesln{$unit}=~ /^(\d+)S/) {
      $ship=$1;
      $avail=$avail+$avail{$ship};
    } else { $ship=""; }
    $wp_eff=20+$buildlcm{$type}+2*$buildhcm{$type};
    $delta=$avail/$wp_eff;
    if ($delta>$planeeff) { $delta=$planeeff; }
    $left=100-$planeeff{$unit};
    $optbuild=&min($left, $planeeff);
    if ($delta>$left) { $delta=$left; }
    if ($left>$delta) { $left=$delta; }
    if ($left>0 && $dump{$xy, 'off'}==0) {
      $leftp=$left/100;
      $mneed=&round($buildmil{$type}*$leftp);
      $lneed=&round($buildlcm{$type}*$leftp);
      $hneed=&round($buildhcm{$type}*$leftp);
      if ($mil{$xy}>$mneed) { $buildp=$leftp; }
      else { $buildp=$mil{$xy}/$buildmil{$type}; }
      if ($lcm{$xy}<$lneed) {
        $buildp=&min($buildp, $lcm{$xy}/$buildlcm{$type});
      }
      if ($hcm{$xy}<$hneed) {
        $buildp=&min($buildp, $hcm{$xy}/$buildhcm{$type});
      }
      if ($buildp<0) { $buildp=0; }
      if ($planesln{$unit}) { $build=$delta; }
      else { $build=$buildp*100; }
      $amneed=&round($buildmil{$type}*$buildp);
      $alneed=&round($buildlcm{$type}*$buildp);
      $ahneed=&round($buildhcm{$type}*$buildp);
      $mil{$xy}-=$mneed;
      $lcm{$xy}-=$lneed;
      $hcm{$xy}-=$hneed;
      if ($dump{$xy, 'des'} cmp '*') { $build/=3; $optbuild/=3;}
      if ($planesln{$unit}=~/^\d+S/) { if ($eff{$unit}+$build>80) { $build=80-$eff{$unit}; } }
      local($used)=$build*$wp_eff;
      $avail=&round($used/100);
      if ($avail<0) { $avail=0; }
      $planeuse{$unit, 'avail'}=$avail;
      $avail{$xy}-=$avail;
      if ($avail{$xy}<0) { $avail{$ship}=$avail{$ship}+$avail{$xy}; $avail{$xy}=0; }
      $neweff{$unit}=$eff{$unit}+$build;
      $maint=$maint+$mult*$buildcost{$type}*$build/100;
      $planeuse{$unit, 'mil'}=$amneed;
      $planeuse{$unit, 'lcm'}=$alneed;
      $planeuse{$unit, 'hcm'}=$ahneed;
      if ($mneed>$amneed && $mil{$xy}<$mneed) { 
        if ($mil{$xy}>-1*$mneed) {
	  $planeneed{$unit, 'mil'}="(".-1*$mil{$xy}.")";
        } else {
          $planeneed{$unit, 'mil'}="(".$mneed.")";
        }
      }
      if ($lneed>$alneed && $lcm{$xy}<$lneed) { 
        if ($lcm{$xy}>-1*$lneed) {
	  $planeneed{$unit, 'lcm'}="(".-1*$lcm{$xy}.")";
        } else {
          $planeneed{$unit, 'lcm'}="(".$lneed.")";
        }
      }
      if ($hneed>$ahneed && $hcm{$xy}<$hneed) { 
        if ($hcm{$xy}>-1*$hneed) {
	  $planeneed{$unit, 'hcm'}="(".-1*$hcm{$xy}.")";
        } else {
          $planeneed{$unit, 'hcm'}="(".$hneed.")";
        }
      }
      if ($avail{$xy}<=0 && $avail{$ship}<=0 && $eff{$unit}<100) { 
	$planeneed{$unit, 'avail'}=int(($optbuild-$build)*$wp_eff/100);
      }
    } else {
      $neweff{$unit}=$planeeff{$unit};
      if ($avail{$xy}<=0 && $avail{$ship}<=0 && $eff{$unit}<100) { 
        $planeneed{$unit, 'avail'}=int($optbuild*$wp_eff/100);
      }
    }
    $planeneed{$unit, 'avail'}=$planeuse{$unit, 'avail'} unless $planeneed{$unit, 'avail'};
    $planemaint{$unit}=int($maint);
  }
  return $mil{$xy}, $lcm{$xy}, $hcm{$xy};
}

$main'functionmap{'sneweff'}='&tools_shipeff'; #'

sub tools_shipeff {
 
  local(@s, %ships, %mil, %lcm, %hcm, %shipuse, %shipneed, %crewneed, %unit, %avail, $x, $y, $out, $area);

  $area = $main'commandarg; #'
  $area = '*' unless $area;

  print STDERR "parsing ship $area...";
  print $main'S "ship $area\n"; #'
  $main'command="ship"; #'
  while(&getline()) {
    if (/%/) {
      ($unit)=/^(\S+)\s+/;
      $ships{$shipsect{$unit}}.="$unit ";
    }
  }
  print STDERR "done\n";
  print " Ship Type                    x,y    Eff  Crew     Lcm      Hcm    Avail Maint\n";
  foreach $xy (keys %ships) {
    print $main'S "dump $xy\n"; #'
    $main'command="dump"; #'
    while(&getline()) { 1; }
    ($lcm{$xy}, $hcm{$xy})=&build_ships($xy);
    ($x, $y)=($xy=~/(\S+),(\S+)/);
    @s=split(/ /, $ships{$xy});
    while($#s>-1) {
      $unit=shift(@s);
      printf "#%-4d %-20s %4d,%-4d %3d%% %-6s %3d%5s %3d%5s %5s \$%4d\n", $unit, $shipname{$unit}, $x, $y, $neweff{$unit}, $crewneed{$unit}, $shipuse{$unit, 'lcm'}, $shipneed{$unit, 'lcm'}, $shipuse{$unit, 'hcm'}, $shipneed{$unit, 'hcm'}, $shipneed{$unit, 'avail'}, $shipmaint{$unit};
    }
    printf "--- total (need/+extra) -- %4d,%-4d             %3d%5s %3d%5s %3d%5s\n",
    $x,$y,
    $lcm{$xy} <= 0?$dump{$xy, 'lcm'}:($dump{$xy, 'lcm'} - $lcm{$xy}),
    $lcm{$xy} == 0?'':'('.($lcm{$xy} < 0?-$lcm{$xy}:('+'.$lcm{$xy})).')',
    $hcm{$xy} <= 0?$dump{$xy, 'hcm'}:($dump{$xy, 'hcm'} - $hcm{$xy}),
    $hcm{$xy} == 0?'':'('.($hcm{$xy} < 0?-$hcm{$xy}:('+'.$hcm{$xy})).')',
    $avail{$xy} <= 0?$dump{$xy, 'avail'}:($dump{$xy, 'avail'} - $avail{$xy}),
    $avail{$xy} == 0?'':'('.($avail{$xy} < 0?-int($avail{$xy}):('+'.int($avail{$xy}))).')';
  }

  foreach $xy (keys %lcm) {
    next if $dump{$xy, 'des'} ne 'h';
    if ($dump{$xy, 'off'}==1) { print "Sector $xy is turned off!\n"; }
    $out="Sector $xy needs";
    if ($lcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", -$lcm{$xy}) , "lcm"); }
    if ($hcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", -$hcm{$xy}) , "hcm"); }
    if (substr($out,length($out)-1,1) cmp "s") { print "$out\n"; }
  }
}
   
sub build_ships {

  local($maint, $avail, $wp_eff, $delta, $left, $leftp, $lneed, $hneed, $alneed, $ahneed, $optbuild, $mult);
  local(@units, %lcm, %hcm, %eff);
  local($xy)=@_;
  local(@units)=split(/ /, $ships{$xy});

  $avail{$xy}=$dump{$xy, 'avail'}; $mil{$xy}=$dump{$xy, 'mil'};
  $lcm{$xy}=$dump{$xy, 'lcm'}; $hcm{$xy}=$dump{$xy, 'hcm'};

  while($#units>-1) {
    $unit=shift(@units);
    if ($tech{$coun}<$planetech{$unit}*0.85) { $mult=2; }
    else { $mult=1; }
    $type=$shipname{$unit}; $eff{$unit}=$shipeff{$unit};
    $maint=$mult*$etu*.001*$buildcost{$type}+$etu*$shipcargo{$unit, "mil"}*$milcost;
    $wf=0;
    if (&is_military_ship($type)) { $wf=$etu*$shipcargo{$unit, "mil"}/2; }
    else { $wf=$etu*($shipcargo{$unit, "civ"}/2+$shipcargo{$unit, "mil"}/5); }
    if ($dump{$xy, "des"} cmp "h") { $wf=$wf/3; $avail=$wf; }
    else { $avail=$wf+$avail{$xy}*100; }
    $wp_eff=20+$buildlcm{$type}+2*$buildhcm{$type};
    if ($dump{$xy, "des"} cmp "h") {
      if (&is_military_ship($type)) {
        $abs_max=$cargo{$type, "mil"}; $amt=$shipcargo{$unit, "mil"};
      } else {
        $abs_max=$cargo{$type, "civ"}; $amt=$shipcargo{$unit, "civ"};
      }
      $avail=$avail-$etu*(100-((100*$amt)/$abs_max))/7;
    }
    if ($avail<=0 && $dump{$xy, "des"} cmp "h") {
      $neweff{$unit}=$eff{$unit}+$avail/$wp_eff;
      if (&is_military_ship($type)) {
        $crewneed{$unit}=&round(100/((7/6)+(100/$cargo{$type, "mil"})))-$shipcargo{$unit, 'mil'};
      } else {
        $crewneed{$unit}=&round((100-(7*$shipcargo{$unit, "mil"}/5))/((7/6)+(100/$cargo{$type, "civ"})))-$shipcargo{$unit, "civ"};
      }
      $crewneed{$unit}="($crewneed{$unit})";
    } else {
      $left=100-$eff{$unit};
      $optbuild=&min($left, $maxshipeff);
      $delta=$avail/$wp_eff;
      if ($delta>$maxshipeff) { $delta=$maxshipeff; }
      if ($delta>$left) { $delta=$left; }
      if ($delta>0 && $left>0 && $dump{$xy, 'off'}==0) {
	if ($left>$delta) { $left=$delta; }
	$leftp=$left/100;
	$lneed=&round($buildlcm{$type}*$leftp);
	$hneed=&round($buildhcm{$type}*$leftp);
	if ($lcm{$xy}>$lneed) { $buildp=$leftp; }
	else { $buildp=$lcm{$xy}/$buildlcm{$type}; }
	if ($hcm{$xy}<$hneed) {
	  $buildp=&min($buildp, $hcm{$xy}/$buildhcm{$type});
	}
	if ($buildp<0) { $buildp=0; }
	$build=$buildp*100;
	$alneed=&round($buildlcm{$type}*$buildp);
	$ahneed=&round($buildhcm{$type}*$buildp);
	$lcm{$xy}-=$lneed;
	$hcm{$xy}-=$hneed;
        $shipuse{$unit, 'lcm'}=$lneed;
        $shipuse{$unit, 'hcm'}=$hneed;
        if ($dump{$xy, "des"} cmp "h") { $build=$delta; }
        $wf=$wf-$build*$wp_eff;
        if ($wf<0) {
          $avail=($avail{$xy}*100+$wf)/100;
	  if ($avail<0) {$avail=0;}
	  $avail{$xy} = $avail;
        }
        if ($dump{$xy, 'des'} cmp 'h') {
          if ($build+$eff{$unit}>80) { 
            $build=80-$eff{$unit};  
            if ($build<0) { 
              $build=0;
              $avail{$xy}=0;
              $lcm{$xy}=-$lneed;
              $hcm{$xy}=-$hneed;
              $optbuild=$build;
              $shipuse{$unit, 'lcm'}=0;
              $shipuse{$unit, 'hcm'}=0;
            }
          }
        }
        $maint=$maint+$mult*$buildcost{$type}*$build/100;
        $neweff{$unit}=$eff{$unit}+$build;
        if ($avail{$xy}<=0 && $eff{$unit}<100) { 
          $shipneed{$unit, 'avail'}="(".int(($optbuild-$build)*$wp_eff/100).")";
        }
	  if ($lneed>$alneed && $lcm{$xy}<$lneed) { 
	    if ($lcm{$xy} > -$lneed) {
	      $shipneed{$unit, 'lcm'}="(".-$lcm{$xy}.")";
	    } else {
	      $shipneed{$unit, 'lcm'}="($lneed)";
	    }
	  }
	  if ($hneed>$ahneed && $hcm{$xy}<$hneed) { 
	    if ($hcm{$xy} > -$hneed) {
	      $shipneed{$unit, 'hcm'}="(".-$hcm{$xy}.")";
	    } else {
	      $shipneed{$unit, 'hcm'}="($hneed)";
	    }
	  }
      } else {
	$neweff{$unit}=$eff{$unit};
        if ($avail{$xy}<=0 && $eff{$unit}<100) { 
          $shipneed{$unit, 'avail'}="(".int($optbuild*$wp_eff/100).")";
        }
      }
    }
    $shipmaint{$unit}=$maint;
  }
  return $lcm{$xy}, $hcm{$xy};
}
 
sub max {
  local($x, $y)=@_;
  if ($x>$y) { return $x; }
  else { return $y; }
}
 
sub min {
  local($x, $y)=@_;
  if ($x<$y) { return $x; }
  else { return $y; }
}

sub round {
  local($val)=@_;
  local($int)=sprintf("%.0f", $val);
  if ($val>$int) { return $int+1; }
  else { return $int; }
}

sub getline {
  $mode = -1;
  $_ = &sock'S_read($main'S, $main'TIMEOUT); #'
  return 0 if $main'status;

  ($mode, $_)=/^\s*(\S+)\s+(.+)*$/;
  if(defined($main'parsemap{$main'command})) {
    eval('&'.$main'game."'".$main'parsemap{$main'command}); #'
  }
  if ($mode eq $main'C_FLUSH ||
      $mode eq $main'C_PROMPT) {
    $main'mode = $mode;
    return 0;
  }
  if ($mode ne $main'C_DATA) {
    $main'mode = $main'C_DATA;
    $_ = "$mode $_";
    &main'parse_serverline;
  }
  return 1;
}

# foreach command
# with replacement of $sect $mil $civ $uw $food $shell $gun $petrol $iron 
# $dust $bar $oil $lcm $hcm $rad
#
# Syntax: foreach AREA cmd
#
# Written by Sam "Drazz'zt" Tetherow

$main'functionmap{'foreach'}='&tools_foreach()'; #'

sub tools_foreach {
  local(@data);
  local($sect, $civ, $mil, $uw, $food, $shell, $gun, $petrol, $iron, $dust, $bar, $oil, $lcm, $hcm, $rad, $tmp);

  local(@arguments)=split(/ /, $main'commandarg); #'
  local($AREA)=shift(@arguments);
  if (substr($arguments[0],0,1) eq '?') {
    $AREA="$AREA " . shift(@arguments);
  }
  local($command)=join(' ', @arguments);
  $command='"' . $command . '"';
  $main'command="dump"; #'
  print $main'S "dump $AREA\n"; #'
  while (&getline()) {
    if (/\./) {
      (@data)=split(/ /, $_);
      $sect=$data[0] . "," . $data[1]; $civ=$data[16]; $mil=$data[17]; 
      $uw=$data[18]; $food=$data[19]; $shell=$data[20]; $gun=$data[21];
      $petrol=$data[22]; $iron=$data[23]; $dust=$data[24]; $bar=$data[25]; 
      $oil=$data[26]; $lcm=$data[27]; $hcm=$data[28]; $rad=$data[29];
      push(@stack,&resolve(eval($command)) . "\n"); 
    }
  }
  while(@stack) { &main'parse_line(shift(@stack)); last if $main'status;}
}

sub resolve {
  local($this)=@_;

  local($x);
  local(@stack)=split(/ /, $this);
  for($x=0; $x<=$#stack; $x++) {
    if ($stack[$x] =~ /\,/) { next; }
    if ($stack[$x] =~ /^[1234567890\-\+\/\*]+/) { $stack[$x]=eval($stack[$x]); }
  }
  return join(' ', @stack);
}

$main'functionmap{'reach'}='&tools_reach'; #'
sub tools_reach {
  local ($reach);
  print "\n--------------Sector Reach Report--------------\n";
  $reach = int(0.07*$techfactor) + 1;
  printf "Fire range of a 100%% fort:       %2.2f (%d at tech %s)\n",
    0.07*$techfactor + 1, $reach + 1, &reach_to_t($reach, 7);
  $reach = int(0.16*$techfactor);
  printf "Radar range general:             %3d  (%d at tech %s)\n", 
    $reach, $reach + 1, &reach_to_t($reach + 1, 16);
  $reach = int(0.08*$techfactor);
  printf "Radar range specifics:           %3d  (%d at tech %s)\n",
    $reach, $reach + 1, &reach_to_t($reach + 1, 8);
  $reach = int(0.04*$techfactor);
  printf "Coastwatch range from non-radar: %3d  (%d at tech %s)\n", 
    $reach, $reach + 1, &reach_to_t($reach + 1, 4);
  $reach = int(0.14*$techfactor);
  printf "Coastwatch range from radar:     %3d  (%d at tech %s)\n", 
    $reach, $reach + 1, &reach_to_t($reach + 1, 14);
}

sub reach_to_t {
  local ($r, $k) = (@_);
  if ($r < $k) {
    sprintf("%3.2f",(200*$r - 50*$k)/($k - $r));
  } else {
    "infinity";
  }
}

$main'functionmap{'sreach'}='&tools_sreach'; #'
sub tools_sreach {
  local ($id, $mobcost, $tfactor, $newmob, $frange);

  &build_ships_target($main'commandarg); #'
  print "\n        --------------Ship Reach Report--------------\n";
  print "                                             Fire   Nav range  Nav range\n";
  print "Ship Type                     x,y  Eff Tech  range    now      next update\n";
  foreach $id (keys %shiptech) {
    if ($target{$id}) {
      $tfactor = (50 + $shiptech{$id})/(200 + $shiptech{$id});
      $mobcost = 48000/(($shipspd{$shipname{$id}} + $shipspd{$shipname{$id}}*$tfactor)*$shipeff{$id});
      $newmob = $shipmob{$id} + $maxshipmob;
      $newmob = 127 if $newmob > 127;
      $frange = $shipeff{$id}>59?($shipfrg{$shipname{$id}}*$tfactor/2):0;
      if ($frange) {
	$frange = sprintf("%3.2f", $frange);
      } else {
	$frange = "";
      }
      printf "%-4d %-20s %7s %3d%% %3d  %6s    %3d         %3d\n",
      $id,$shipname{$id},$shipsect{$id},$shipeff{$id},$shiptech{$id},
      $frange,
      $shipmob{$id}>0?int($shipmob{$id}/$mobcost+0.999):0,
      int($newmob/$mobcost+0.999);
    }
  }
}

$main'functionmap{'lreach'}='&tools_lreach'; #'
sub tools_lreach {
  local ($id, $mobcost, $tfactor, $newmob, $frange);

  &build_lands_target($main'commandarg); #'
  print "\n        --------------Land Unit Reach Report--------------\n";
  print "                                             Fire   Mar range  Mar range\n";
  print "Unit Type                     x,y  Eff Tech  range    now      next update\n";
  foreach $id (keys %unittech) {
    if ($target{$id}) {
      $tfactor = (50 + $unittech{$id})/(200 + $unittech{$id});
      $mobcost = 48000/(($unitspd{$unitname{$id}} + $unitspd{$unitname{$id}}*$tfactor)*$uniteff{$id});
      $newmob = $unitmob{$id} + $unitmob;
      $newmob = 127 if $newmob > 127;
      $frange = $uniteff{$id}>59?($unitfrg{$unitname{$id}}*$tfactor):0;
      if ($frange) {
	$frange = sprintf("%3.2f", $frange);
      } else {
	$frange = "";
      }
      printf "%-4d %-20s %7s %3d%% %3d  %6s    %3d         %3d\n",
      $id,$unitname{$id},$unitsect{$id},$uniteff{$id},$unittech{$id},
      $frange,
      $unitmob{$id}>0?int($unitmob{$id}/$mobcost+0.999):0,
      int($newmob/$mobcost+0.999);
    }
  }
}

$main'functionmap{'fus'}='&tools_fus'; #'
sub tools_fus {
  local($id, $fuelmob, $mobcost, $tfactor);

  &build_ships_target($main'commandarg); #'
  &print_n_parse("dump *");

  foreach $id (keys %shipname) {
    next if !$target{$id} ||
            $shipfuel{$id} == $fuelcar{$shipname{$id}};
    if ($dump{$shipsect{$id}, 'des'} ne 'h') {
      if (!$shipfuel{$id} && $shipmob{$id} <= 0) {
	printf "Oops: ship \#%d %s is stranded at sea with no fuel and no mobility.\n",
	$id, $shipname{$id};
      } else {
	$tfactor = (50 + $shiptech{$id})/(200 + $shiptech{$id});
	$fuelmob = 10*($shipfuel{$id}/$fueluse{$shipname{$id}});
	if ($shipmob{$id} + $maxshipmob > 127) {
	  $fuelmob += 127 - $maxshipmob;
	} else {
	  $fuelmob += $shipmob{$id};
	}
	$mobcost = 48000/(($shipspd{$shipname{$id}}+$shipspd{$shipname{$id}}
			   *$tfactor)*$shipeff{$id});
	printf "ship \#%d %s is at sea and will run out of fuel in %.1f updates (%d sectors).\n",
	$id,
	$shipname{$id},
	$shipfuel{$id}/($fueluse{$shipname{$id}}*($maxshipmob/10)),
	int($fuelmob/$mobcost+0.9999);
      }
    } elsif ($own{$shipsect{$id}} != $coun) {
      $tfactor = (50 + $shiptech{$id})/(200 + $shiptech{$id});
      $fuelmob = 10*($shipfuel{$id}/$fueluse{$shipname{$id}});
      if ($shipmob{$id} + $maxshipmob > 127) {
	$fuelmob += 127 - $maxshipmob;
      } else {
	$fuelmob += $shipmob{$id};
      }
      $mobcost = 48000/(($shipspd{$shipname{$id}}+$shipspd{$shipname{$id}}
			 *$tfactor)*$shipeff{$id});
      printf "ship \#%d %s is in %s's harbour and will run out of fuel in %.1f updates (%d sectors).\n",
      $id,
      $shipname{$id},
      $country{$own{$shipsect{$id}}},
      $shipfuel{$id}/($fueluse{$shipname{$id}}*($maxshipmob/10)),
      int($fuelmob/$mobcost+0.9999);
    } else {
      if ($dump{$shipsect{$id},'oil'} == 0 &&
	  $dump{$shipsect{$id},'pet'} == 0) {
	print "Warning: Not enough fuel in $shipsect{$id} to fuel ship \#$id $shipname{$id}!\n";
      } else {
	&send("fuel ship $id ".($fuelcar{$shipname{$id}} - $shipfuel{$id}));
      }
    }
  }
}

$main'functionmap{'crew'}='&tools_crew'; #'
sub tools_crew {
  local($id,$type,$milship,$cneed,$mneed,$mil,$civ);

  &build_ships_target($main'commandarg); #'

  print "\n-----------------Ship Crew Report-----------------\n";
  printf "%4s %-20s %8s     %s\n",
  'shp#', 'type', 'needs', 'can unload';

  foreach $id (keys %shipname) {
    next if !$target{$id};
    $type = $shipname{$id};
    if ($milship = &is_military_ship($type)) {
      $mneed = &round(100/((7/6)+(100/$cargo{$type, 'mil'})));
      $mil = $shipcargo{$id, 'mil'};
    } else {
      $cneed = &round((100-(7*$shipcargo{$id, "mil"}/5))/((7/6)+(100/$cargo{$type, "civ"})));
      $civ = $shipcargo{$id, 'civ'};
    }
    next if $milship && $civ == $mneed ||
            !$milship && $mil == $cneed;
    if ($milship) {
      if ($mil < $mneed) {
	printf "%4s %-20s %8s     %s\n",
	$id, $type, ($mneed - $mil)." mil", '';
      } else {
	printf "%4s %-20s %8s      %s\n",
	$id, $type, '', ($mil - $mneed)." mil";
      }
    } else {
      if ($civ < $cneed) {
	printf "%4s %-20s  %8s     %s\n",
	$id, $type, ($cneed - $civ)." civs", '';
      } else {
	printf "%4s %-20s  %8s     %s\n",
	$id, $type, '', ($civ - $cneed)." civs";
      }
    }
  }
}

sub is_military_ship {
  local($type) = @_;

  $shipfir{$type} || !$cargo{$type,'civ'};
}

$main'functionmap{'jack'}='&tools_jack'; #'
sub tools_jack {
  local($sect);

  &build_sect_target($main'commandarg); #'
  &print_n_parse("prod *");

  foreach $sect (keys %own) {
    next if !$target{$sect} ||
            $own{$sect} != $coun ||
	      ($newdes{$sect} ne 'j' &&
               $newdes{$sect} ne 'k');
    if ($use1{$sect} < $max1{$sect} && $dump{$sect, 'i_dist'} < $max1{$sect}) {
      &send("th i $sect $max1{$sect}");
    }
  }
}

$main'functionmap{'rebel'}='&tools_rebel'; #'
sub tools_rebel {
  local($sect);

  &build_sect_target($main'commandarg); #'

  print "\n--------------Che Riviera Report--------------\n";
  printf "%7s %3s %3s   %5s    %5s\n", 'sector', 'des', 'mob', 'extra', 'needs';
  foreach $sect (keys %own) {
    next if !$target{$sect} ||
            $own{$sect} != $coun;
    if ($dump{$sect,'*'} eq '*') {
      if ($dump{$sect,'mil'} < int($dump{$sect,'civ'}/10) + 2) {
	printf "%7s %3s %3s   %5s    %5s\n", $sect, $dump{$sect,'des'}, '', '',
	int($dump{$sect,'civ'}/10) - $dump{$sect,'mil'} + 2;
      } elsif ($dump{$sect,'mil'} > int($dump{$sect,'civ'}/10) + 4 &&
	       $dump{$sect,'mob'} > 1) {
	printf "%7s %3s %3s   %5s    %5s\n", $sect, $dump{$sect,'des'},$dump{$sect,'mob'},
	$dump{$sect,'mil'} - int($dump{$sect,'civ'}/10) - 4, '';
      }
    }
  }
}

$main'functionmap{'civs'}='&tools_civs'; #'
sub tools_civs {
  local($sect, $use, $extra, $effdelta, $des, $neweff);
  local ($c1, $c2, $c3, $d1, $d2, $d3, $f21, $f31, $work, $why, $area);

  $area = $main'commandarg; #'
  $area = '*' unless $area;
  &build_sect_target($area);

  &print_n_parse("prod $area");
  &print_n_parse("neweff $area");

  print "\n--------------Workforce Employment Report--------------\n";
  printf "      sector     neweff  workforce extra        needs\n";
  foreach $sect (keys %own) {
    next if !$target{$sect} ||
            $own{$sect} != $coun ||
            $dump{$sect,'work'} < 90 ||
            $oldown{$sect} != $coun;
    $why = '';
  
# Calculate delta in sector efficiency
    $des = $dump{$sect, 'des'};
    if ($des eq $newdes{$sect}) {
      if ($dump{$sect, 'eff'} < $neweff{$sect}) { # building up
	if ($neweff{$sect} > 30) {
	  if ($neweff{$sect} > 61) {
	    $effdelta = 100 - $dump{$sect, 'eff'};
	    $why = "to become 100%";
	  } else {
	    $effdelta = 61 - $dump{$sect, 'eff'};
	    $why = "to become 61%";
	  }
	} else {
	  $effdelta = 0;
	}
      } elsif ($dump{$sect, 'eff'} > $neweff{$sect}) { # tearing down
	$effdelta = ($dump{$sect, 'eff'} - $neweff{$sect}) / 4;
      } else {
	$effdelta = 0;
      }
    } else { # tear down and build up
      $effdelta = $dump{$sect, 'eff'} / 4 + $neweff{$sect};
      if ($neweff{$sect} > 30) {
	if ($neweff{$sect} > 61) {
	  $effdelta += 100 - $neweff{$sect};
	  $why = "to become 100%";
	} else {
	  $effdelta += 61 - $neweff{$sect};
	  $why = "to become 61%";
	}
      }
    }
    
    if ($use1{$sect}) {		# It consumes
      if ($use1{$sect} < $max1{$sect}) { # Too many civs
	$use = $use1{$sect} + $use2{$sect} + $use3{$sect};
	$extra = $wkfc{$sect} -
	  (($use>$effdelta?$use:0) + 2 * $effdelta) * 100 / $etu;
      } elsif ($des ne 'e') { # Maybe it needs more civs
	$c1 = $dump{$sect,$comm1{$sect}};
	$c2 = $dump{$sect,$comm2{$sect}} if $comm2{$sect};
	$c3 = $dump{$sect,$comm3{$sect}} if $comm3{$sect};
	if ($use3{$sect}) {
	  $f21 = $use2{$sect}/$use1{$sect};
	  $f31 = $use3{$sect}/$use1{$sect};
	  $d1 = $c1 - $use1{$sect};
	  $d2 = $c2 - $use2{$sect};
	  $d3 = $c3 - $use3{$sect};
	  if ($d1 > 0 && $f21 * $d1 < $d2 && $f31 * $d1 < $d3) {
	    $work = (1 + $f21 + $f31) * $d1;
	    $why = "to be able to use ".($use1{$sect}+$d1)." ".$comm1{$sect};
	  } elsif ($d2 > 0 && $d2 < $f21 * $d1 && $f31 * $d2 < $f21 * $d3) {
	    $work = (1/$f21 + 1 + $f31/$f21) * $d2;
	    $why = "to be able to use ".($use2{$sect}+$d2)." ".$comm2{$sect};
	  } elsif ($d3 > 0 && $d3 < $f31 * $d1 && $f21 * $d3 < $f31 * $d2) {
	    $work = (1/$f31 + $f21/$f31 + 1) * $d3;
	    $why = "to be able to use ".($use3{$sect}+$d3)." ".$comm3{$sect};
	  } else {
	    $work = 0;
	  }
	} elsif ($use2{$sect}) {
	  $f21 = $use2{$sect}/$use1{$sect};
	  $d1 = $c1 - $use1{$sect};
	  $d2 = $c2 - $use2{$sect};
	  if ($d1 > 0 && $f21 * $d1 < $d2) {
	    $work = (1 + $f21) * $d1;
	    $why = "to be able to use ".($use1{$sect}+$d1)." ".$comm1{$sect};
	  } elsif ($d2 > 0 && $d2 < $f21 * $d1) {
	    $work = (1/$f21 + 1) * $d2;
	    $why = "to be able to use ".($use2{$sect}+$d2)." ".$comm2{$sect};
	  } else {
	    $work = 0;
	  }
	} elsif ($use1{$sect} < $c1) {
	  $work = $c1 - $use1{$sect};
	  $why = "to be able to use ".($use1{$sect}+$work)." ".$comm1{$sect};
	} else {
	  $work = 0;
	}
	$extra = -$work * 100 / $etu;
      } else {
	$extra = 0;
      }
    } elsif ($will{$sect}) {	# It produces but doesn't consume
      $extra = 0;
    } elsif ($des eq 'h' ||
	     $des eq '*' ||
	     $des eq '!' ||
	     $des eq 'f' ||
	     $des eq 'c') {
      $extra = 0;
    } else {			# It doesn't produce
      $extra = $dump{$sect,'civ'} * (1 + $obrate * $etu) +
	       $dump{$sect,'uw'} * (1 + $uwbrate * $etu) +
               $dump{$sect,'mil'} / 5 -
               2 * $effdelta * 100 / $etu;
    }
    $extra = int($extra / (1 + $obrate * $etu) - 1);
    if ($extra && $extra < $dump{$sect, 'civ'} - $maxciv) {
      $extra = $dump{$sect, 'civ'} - $maxciv;
    }
    if ($extra > 1) {
      local ($cextra,$uextra);
      $cextra = &min($extra,$dump{$sect, 'civ'});
      $uextra = &min($extra-$cextra,$dump{$sect, 'uw'});
      $cextra -=1 if ($cextra && $uextra);
      printf "%7s %1s %3d%%   %1s %4s   %4s    %4s %4s\n",
      $sect,
      $des,
      $dump{$sect, 'eff'},
      ($newdes{$sect} ne $des)?$newdes{$sect}:'',
      ($neweff{$sect} != $dump{$sect, 'eff'})?$neweff{$sect}.'%':'',
      int($dump{$sect,'civ'} + $dump{$sect,'uw'} + $dump{$sect,'mil'} / 5),
      $cextra?($cextra.'c'):'',
      $uextra?($uextra.'u'):'';
    } elsif ($extra < -1) {
      printf "%7s %1s %3d%%   %1s %4s   %4s    %5s   %5s %s\n",
      $sect,
      $des,
      $dump{$sect, 'eff'},
      ($newdes{$sect} ne $des)?$newdes{$sect}:'',
      ($neweff{$sect} != $dump{$sect, 'eff'})?$neweff{$sect}.'%':'',
      int($dump{$sect,'civ'} + $dump{$sect,'uw'} + $dump{$sect,'mil'} / 5),
      '',
      -$extra,
      $why?'('.$why.')':'';
    }
  }
}

$main'functionmap{'delta'}='&tools_prod_delta';  #'

# prod_delta: originally written by Ken Stevens as a standalone perl script, 
#  added to tools.pl by Sam Tetherow

sub tools_prod_delta {
  local(%plus, %minus, %have, @usable, @unusable, $xy, $com, %unituse, %unitneed, %planeuse, %planeneed, %shipuse, %shipneed, $unit, $plane, $ship, %units, %planes, %ships, $area);
 
  $area = $main'commandarg; #'
  $area = '*' unless $area;

  &build_sect_target($area);
  
  &print_n_parse("dump *") if $area ne '*';
  &print_n_parse("product *");

  print STDERR "parsing land *...";
  $main'command="land"; #'
  print $main'S "land *\n"; #'
  while(&getline()) {
    if (/\s*(\d+)\s+.+%/) {
      $units{$unitsect{$1}}.="$1 ";
    }
  } 
  print STDERR "done\n";

  foreach $xy (keys %units) {
    local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}";
    if ($target{$disthit}) {
      &build_units($xy);
    }
  }
  foreach $unit (keys %unitmob) {	# Use mob so you don't get enemy units
    $minus{'mil'}+=$unituse{$unit, 'mil'};
    $minus{'lcm'}+=$unituse{$unit, 'lcm'};
    $minus{'hcm'}+=$unituse{$unit, 'hcm'};
    $minus{'gun'}+=$unituse{$unit, 'gun'};
    $minus{'shell'}+=$unituse{$unit, 'shell'};
  }

  print STDERR "parsing plane *...";
  $main'command="plane"; #'
  print $main'S "plane *\n"; #'
  while(&getline()) {
    if (/\s*(\d+)\s+.+%/) {
      $planes{$planesect{$1}}.="$1 ";
    }
  } 
  print STDERR "done\n";

  foreach $xy (keys %planes) {
    local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}";
    if ($target{$disthit}) {
      &build_planes($xy);
    }
  }
  foreach $plane (keys %planemob) {	# Use mob so you don't get enemy planes
    $minus{'mil'}+=$planeuse{$plane, 'mil'};
    $minus{'lcm'}+=$planeuse{$plane, 'lcm'};
    $minus{'hcm'}+=$planeuse{$plane, 'hcm'};
  }

  print STDERR "parsing ship *...";
  $main'command="ship"; #'
  print $main'S "ship *\n"; #'
  while(&getline()) {
    if (/\s*(\d+)\s+.+%/) {
      $ships{$shipsect{$1}}.="$1 ";
    }
  } 
  print STDERR "done\n";

  foreach $xy (keys %ships) {
    local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}";
    if ($target{$disthit}) {
      &build_ships($xy);
    }
  }
  foreach $ship (keys %shipmob) {	# Use mob so you don't get enemy ships
    $minus{'lcm'}+=$shipuse{$ship, 'lcm'};
    $minus{'hcm'}+=$shipuse{$ship, 'hcm'};
  }

  foreach $xy (keys %will) {			# all producing sectors
    local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}";
    next unless $target{$disthit};
    $plus{$make{$xy}}+=&min($will{$xy}, $prodmax{$xy});
    if ($comm1{$xy}) {
      $minus{$comm1{$xy}}+=$use1{$xy};
    }
    if ($comm2{$xy}) {
      $minus{$comm2{$xy}}+=$use2{$xy};
    }
    if ($comm3{$xy}) {
      $minus{$comm3{$xy}}+=$use3{$xy};
    }
  }
  foreach $xy (keys %own) {
    local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}";
    next unless $target{$disthit};
    next unless $own{$xy}==$main'coun;			#' skip if not ours
    foreach $com (values %commstr) {			# for all commodites
      $have{$com}+=$dump{$xy, $com};
    }
   				# Fort usage of hcms
    if (($dump{$xy,'des'} eq 'f' && $dump{$xy,'eff'}<100) || $dump{$xy,'sdes'} eq 'f') {
      $main'command='neweff'; #'
      print $main'S "neweff $xy\n"; #'
      while(&getline()) { 1; }
      if ($neweff{$xy}>$dump{$xy, 'eff'} && $dump{$xy, 'des'} eq 'f') {
        $minus{'hcm'}+=$buildhcm{'f'}*($neweff{$xy}-$dump{$xy, 'eff'});
      } elsif ($dump{$xy, 'sdes'} eq 'f') {
        $minus{'hcm'}+=$buildhcm{'f'}*$neweff{$xy};
      }
    }
  }
  $plus{'civ'}=int($have{'civ'}*$obrate*$etu);
  $plus{'uw'}=int($have{'uw'}*$uwbrate*$etu);
  $minus{'food'}=int(($have{'civ'}+$have{'uw'}+$have{'mil'})*$etu*$eatrate+($plus{'civ'}+$plus{'uw'})*$babyeat);

  print "\n--------------------Production Delta Report--------------------\n";
  printf "%5s %8s %8s %8s %8s %8s %8s\n", 'com', 'start', '+', '-', 'delta', 'net', 'supply';
  @usable=('food', 'iron', 'oil', 'dust', 'lcm', 'hcm');
  @nonusable=('bar', 'pet', 'shell', 'gun', 'civ', 'uw', 'mil');
  while($com=shift(@usable)) {
    if ($have{$com}!=0 || $plus{$com}!=0) {
      printf "%5s %8s %8s %8s %8s %8s %8s\n", $com, $have{$com}, $plus{$com}, $minus{$com}, $plus{$com}-$minus{$com}, $have{$com}+$plus{$com}-$minus{$com}, &prod_warn($have{$com}, $plus{$com}-$minus{$com});
    }
  }
  print "---------------------------------------------------------------\n";
  while($com=shift(@nonusable)) {
    if ($have{$com}!=0 || $plus{$com}!=0) {
      printf "%5s %8s %8s %8s %8s %8s\n", $com, $have{$com}, $plus{$com}, '', '', $have{$com}+$plus{$com};
    }
  }
} 

$main'functionmap{'fdelta'}='&tools_food_delta';  #'

# food_delta: Originally written by Ken Stevens as part of delta a standalone
#  perl tool, added to tools.pl by Sam Tetherow

sub tools_food_delta {
  local($type, $civcount, $uwcount, $sectcount, $citycount, $foodcount);
  local($xy, $fprod, $cbaby, $ubaby, $area);

  $area = $main'commandarg; #'
  $area = '*' unless $area;
  &build_sect_target($area);

  &print_n_parse("dump *") if $area ne '*';
  &print_n_parse("product *");

  foreach $xy (keys %own) {
    next unless $own{$xy}==$main'coun; #'
    $dist="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}";
    next unless $target{$dist};
    $civcount+=$dump{$xy, 'civ'};
    $uwcount+=$dump{$xy, 'uw'};
    if ($dump{$xy, 'des'} ne '^') {
      if ($dump{$xy, 'des'} eq 'c' && defined($option{'BIG_CITY'})) {
	++$citycount;
      } else {
	++$sectcount;
      }
    }
    $foodcount+=$dump{$xy, 'food'};

				# If this sector products food add it
    if ($make{$xy} eq 'food') {
      $fprod+=&min($will{$xy}, $prodmax{$xy});
    }
  }
  local($civmax)=$sectcount*$maxpop + $citycount*$maxpop*10;
  local($uwmax)=$civmax;
  local($civ)=$civcount+$milcount;
  local($uw)=$uwcount;
  local($foo)=$foodcount;
  print "\n           ----FOOD DELTA REPORT----\n";
  printf "%6s %6s %6s %6s %6s %6s %6s\n", '', 'start', '', '', 'food', 'food', 'food';
  printf "%6s %6s %6s %6s %6s %6s %6s\n", 'update', 'food', 'civ', 'uw', 'eaten', 'prod', 'delta';
  print "---------------------------------------------------\n";
  for($i=1; $i<=15; ++$i) {
    local($cbaby)=$civ*$obrate*$etu;
    local($ubaby)=$uw*$uwbrate*$etu;
    local($eaten)=(($civ+$uw)*$eatrate*$etu)+(($cbaby+$ubaby)*$babyeat);
    local($delta)=$fprod-$eaten;
    printf "%5d: %6d %6d %6d %6d %6d %6d\n", $i, $foo, $civ, $uw, $eaten, $fprod, $delta;
    $foo +=$delta;
    $civ +=$cbaby;
    $civ=$civmax if $civ>$civmax;
    $uw +=$ubaby;
    $uw=$uwmax if $uw>$uwmax;
  }
  if ($citycount) {
    print "Maximum civs for $citycount cities and $sectcount sectors: $civmax\n";
    print "Maximum uws for $citycount cities and $sectcount sectors: $uwmax\n";
  } else {
    print "Maximum civs for $sectcount sectors: $civmax\n";
    print "Maximum uws for $sectcount sectors: $uwmax\n";
  }
}

$main'functionmap{'wdelta'}='&tools_warehouse_delta';  #'

# warehouse_delta: Written by Sam Tetherow to show warehouse action at the 
# update.

sub tools_warehouse_delta {
  local(%distcenters, %use, %make, @usabel, @nonusable);
  local($type, $dist, $xy, $c, $civbabies, $uwbabies, $com, $area);

  $area = $main'commandarg; #'
  $area = '*' unless $area;
 
  &build_sect_target($area);
  &print_n_parse("dump *") if $area ne '*';
  &print_n_parse("product *");

  print STDERR "parsing land *...";
  $main'command="land"; #'
  print $main'S "land *\n"; #'
  while(&getline()) {
    if (/\s+(\d+)\s+.+%/) {
      $units{$unitsect{$1}}.="$1 ";
    }
  } 
  print STDERR "done\n";

  print STDERR "parsing plane *...";
  $main'command="plane"; #'
  print $main'S "plane *\n"; #'
  while(&getline()) {
    if (/\s+(\d+)\s+.+%/) {
      $planes{$planesect{$1}}.="$1 ";
    }
  } 
  print STDERR "done\n";

  print STDERR "parsing ship *...";
  $main'command="ship"; #'
  print $main'S "ship *\n"; #'
  while(&getline()) {
    if (/\s+(\d+)\s+.+%/) {
      $ships{$shipsect{$1}}.="$1 ";
    }
  } 
  print STDERR "done\n";

  foreach $xy (keys %own) {
    next unless $own{$xy}==$main'coun; #'
    $dist="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}";
    next if $dist eq $xy;
				# If the distcenter is undefined (1st occurance)
				# initialize the use variables.
    if (!defined($distcenters{$dist})) {
      if ($target{$dist}) { 
	$distcenters{$dist}=1;
      } else { 
	$distcenters{$dist}=0;
      }
    }

    next unless $distcenters{$dist}==1;

    undef %unituse;
    undef %unitneed;
    undef %planeuse;
    undef %planeneed;
    undef %shipuse;
    undef %shipneed;
    &build_units($xy) if $units{$xy};
    &build_planes($xy) if $planes{$xy};
    &build_ships($xy) if $ships{$xy};
    foreach $unit (keys %unituse) {
      $use{$xy, 'mil'}+=$unituse{$unit, 'mil'};
      $use{$xy, 'lcm'}+=$unituse{$unit, 'lcm'};
      $use{$xy, 'hcm'}+=$unituse{$unit, 'hcm'};
      $use{$xy, 'gun'}+=$unituse{$unit, 'gun'};
      $use{$xy, 'shell'}+=$unituse{$unit, 'shell'};
    }
    foreach $plane (keys %planeuse) {
      $use{$xy, 'mil'}+=$planeuse{$plane, 'mil'};
      $use{$xy, 'lcm'}+=$planeuse{$plane, 'lcm'};
      $use{$xy, 'hcm'}+=$planeuse{$plane, 'hcm'};
    }
    foreach $ship (keys %shipuse) {
      $use{$xy, 'lcm'}+=$shipuse{$ship, 'lcm'};
      $use{$xy, 'hcm'}+=$shipuse{$ship, 'hcm'};
    }

   				# Fort usage of hcms
    if (($dump{$xy,'des'} eq 'f' && $dump{$xy,'eff'}<100) || $dump{$xy,'sdes'} eq 'f') {
      $main'command='neweff'; #'
      print $main'S "neweff $xy\n"; #'
      while(&getline()) { 1; }
      if ($neweff{$xy}>$dump{$xy, 'eff'} && $dump{$xy, 'des'} eq 'f') {
        $use{$xy, 'hcm'}+=$buildhcm{'f'}*($neweff{$xy}-$dump{$xy, 'eff'});
      } elsif ($dump{$xy, 'sdes'} eq 'f') {
        $use{$xy, 'hcm'}+=$buildhcm{'f'}*$neweff{$xy};
      }
    }
    if ($will{$xy}) {
      $make{$xy, $make{$xy}}+=&min($will{$xy}, $prodmax{$xy});
      $use{$xy, $comm1{$xy}}+=$use1{$xy} if $comm1{$xy};
      $use{$xy, $comm2{$xy}}+=$use2{$xy} if $comm2{$xy};
      $use{$xy, $comm3{$xy}}+=$use3{$xy} if $comm3{$xy};
    }

					# Grow population and figure food.
    if ($dump{$xy, 'civ'}<$maxciv) {
      $civbabies=$dump{$xy, 'civ'}*$obrate*$etu;
      if ($civbabies+$dump{$xy, 'civ'}>$maxciv) { $civbabies=$maxciv-$dump{$xy, 'civ'}; }
      $make{$xy, 'civ'}+=$civbabies;
    }
    if ($dump{$xy, 'uw'}<$maxuw) {
      $uwbabies=$dump{$xy, 'uw'}*$uwbrate*$etu;
      if ($uwbabies+$dump{$xy, 'uw'}>$maxuw) { $uwbabies=$maxuw-$dump{$xy, 'uw'}; }
      $make{$xy, 'uw'}+=$uwbabies;
    }
    $use{$xy, 'food'}+=($dump{$xy, 'civ'}+$dump{$xy, 'mil'}+$dump{$xy, 'uw'})*$etu*$eatrate;
    $use{$xy, 'food'}+=($uwbabies+$civbabies)*$babyeat;

				# If we have non-0 threshes account for them.
    foreach $c (keys %commstr) {
      local($distkey)="$c" . "_dist";
      local($com)=$commstr{$c};
      if ($dump{$xy, $distkey}!=0) {
        if ($dump{$dist, $com}+$make{$dist, $com}-$use{$dist, $com}<=9999) {
          if ($dump{$xy, $distkey}<$dump{$xy, $com}+$make{$xy, $com}-$use{$xy, $com}) {
            $make{$dist, $com}+=$dump{$xy, $com}+$make{$xy, $com}-$use{$xy, $com}-$dump{$xy, $distkey};
          } else {
            $use{$dist, $com}+=$dump{$xy, $distkey}-($dump{$xy, $com}+$make{$xy, $com}-$use{$xy, $com});
          }
        }
      }
    }
  }
   
  foreach $xy (keys %distcenters) {
    @usable=('food', 'iron', 'oil', 'dust', 'lcm', 'hcm');
    @nonusable=('bar', 'pet', 'shell', 'gun', 'civ', 'uw', 'mil');
    if ($distcenters{$xy}!=1) { next; }
    print "\n--------------------Distcenter $xy--------------------\n";
    printf("  %6s %8s %8s %8s %8s %8s %8s\n", "Com", "Start", "+", "-", "Delta", "Net", "Supply");
    while($com=shift(@usable)) {
      if ($dump{$xy, $com}!=0 || $make{$xy, $com}!=0) {
	printf("  %6s %8d %8d %8d %8d %8d %8s\n", $com, $dump{$xy, $com}, $make{$xy, $com}, $use{$xy, $com}, $make{$xy, $com}-$use{$xy, $com}, $dump{$xy, $com}+$make{$xy, $com}-$use{$xy, $com}, &prod_warn($dump{$xy, $com}, $make{$xy, $com}-$use{$xy, $com}));
      }
    }
    print "----------------------------------------------------------------\n";
    while($com=shift(@nonusable)) {
      if ($dump{$xy, $com}!=0 || $make{$xy, $com}!=0) {
	printf("  %6s %8d %8d %8s %8s %8d\n", $com, $dump{$xy, $com}, $make{$xy, $com}, ' ', ' ', $dump{$xy, $com}+$make{$xy, $com});
      }
    }
  }
}
 
sub prod_warn {
  local($start, $delta)=@_;
  if ($delta>=0) { return ''; }
  return int(-1*$start / $delta) . '';
}

sub in_realm {				# in_realm($realmstring, $sect)
  local($realm, $sect)=@_;
  if ($realm eq '*') { return 1; }
  local($left,$top)=split(/,/, $realm);
  local(@tmp)=split(/:/, $left);
  local($left)=shift(@tmp); local($right)=shift(@tmp);
  $right=$left unless $right;
  local(@tmp)=split(/:/, $top);
  local($top)=shift(@tmp); local($bottom)=shift(@tmp);
  $bottom=$top unless $bottom;
  ($x, $y)=split(/,/, $sect);
  if ($left<=$right) {
    if ($top<=$bottom) {
      if ($x>=$left && $x<=$right && $y>=$top && $y<=$bottom) { return 1; }
      else { return 0; }
    } else {
      if ($x>=$left && $x<=$right && (($y>=$top && $y<$height/2) || ($y<=$bottom && $y>=-1*$height/2))) { 
        return 1;
      } else { return 0; }
    }
  } else {
    if ($bottom<=$top) {
      if (($y>=$top && $y<=$bottom) && (($x>=$left && $x<$width/2) || ($x<=$right && $x>=-1*$width/2))) { 
        return 1;
      } else { return 0; }
    } else {
      if ((($x>=$left && $x<$width/2) || ($x<=$right && $x>=-1*$width/2)) &&
          (($y>$top && $y<$height/2) || ($y<$bottom && $y>-1*$height/2))) { 
        return 1;
      } else { return 0; }
    }
  }
  return 0;
}
  
$main'functionmap{'stat'} = '&tools_status'; #'
# Here are the status commands to get info out of the internal DB
# I don't if these should go in tools.pl or parse.pl, but tools seemed to
# be the logical place for them.

# status will get you information about a sector in enemy territory
# I should probably add dating to information while I am at it because it
# would be nice to know how old this information is.

sub tools_status {
  local(@switch, @equal, @less, @nequal, @great, @tmp, $amt, $val, $xy, $fail);
  local($mon, $mday, $hour, $min);
  if ($main'commandarg=~/\s*(\S+)\s*(.*)/) {
    $area=$1;
    $switches=$2 if $2;
  } else {
    print STDERR "stat <AREA> (?switch)\n";
    return;
  }
  if ($area=~/#(\d+)/) {
    $area=$realm{$1};
  }
  $switches=~s/^\?//; 
  local(@switch)=split(/&/, $switches);
  while($tmp=shift(@switch)) {
    if ($tmp=~/(\S+)=(\S+)/) { push(@equal, "$1 $2"); } # mask type to des
    elsif ($tmp=~/(\S+)\#(\S+)/) { push(@nequal, "$1 $2"); }
    elsif ($tmp=~/(\S+)<(\S+)/) { push(@less, "$1 $2"); }
    elsif ($tmp=~/(\S+)>(\S+)/) { push(@great, "$1 $2"); }
    else { print "Unknown switch $tmp\n"; return; }
  }
  foreach $xy (keys %own) {
    push(@sects, $xy) if &in_realm($area, $xy);
  }
  print "own  x,y   des eff civ mil  pet food   fort   ship    air   land  date\n";
  $sectcount=0;
  while($xy=shift(@sects)) {
    $fail=0; ($x, $y)=($xy=~/(\S+),(\S+)/);
    @tmp=@equal;
    while($#tmp>-1) {
      ($val, $amt)=split(/ /, shift(@tmp),2);
      if ($val eq 'type') { $val='des'; }
      if ($val eq 'own') {
        if ($own{$xy} ne $amt && $own{$xy} ne $number{$amt}) { $fail=1; }
      } elsif ($dump{$xy, $val} ne $amt) { $fail=1; }
    }
    @tmp=@nequal;
    while($#tmp>-1) {
      ($val, $amt)=split(/ /, shift(@tmp),2);
      if ($val eq 'type') { $val='des'; }
      if ($val eq 'own') {
        if ($own{$xy} ne $amt) { $fail=1; }
      } elsif ($dump{$xy, $val} eq $amt) { $fail=1; }
    }
    @tmp=@less;
    while($#tmp>-1) {
      ($val, $amt)=split(/ /, shift(@tmp),2);
      if ($val eq 'type') { $val='des'; }
      if ($dump{$xy, $val}>=$amt) { $fail=1; }
    }
    @tmp=@great;
    while($#tmp>-1) {
      ($val, $amt)=split(/ /, shift(@tmp),2);
      if ($val eq 'type') { $val='des'; }
      if ($dump{$xy, $val}<=$amt) { $fail=1; }
    }
    if ($fail==0) {
      ($mon, $mday, $hour, $min)=($dump{$xy, 'date'}=~
        /(\d+)\/(\d+) (\d+):(\d+)/);
      printf "%2d%4d,%-4d %1s %3s%%%4d %3s %4s %4s %6s %6s %6s %6s %3s %2d %02d:%02d\n",
        $own{$xy},
        $x, $y,
        $dump{$xy, 'des'},
        $dump{$xy, 'eff'},
        $dump{$xy, 'civ'},
        $dump{$xy, 'mil'},
        $dump{$xy, 'pet'},
        $dump{$xy, 'food'},
        $def{$xy, 'fort'},
        $def{$xy, 'ship'},
        $def{$xy, 'plane'},
        $def{$xy, 'land'},
        $main'monthname{$mon},
        $mday,
        $hour,
        $min;
      $sectcount++;
    }
  }
  print "$sectcount Sectors.\n";
}

$main'functionmap{'lstat'}='&tools_lstat'; #'

sub tools_lstat {
  local(@switch, @equal, @less, @nequal, @great, @tmp, $amt, $val, $xy, $fail);
  local($mon, $mday, $hour, $min);
  if ($main'commandarg=~/\s*(\S+)\s*(.*)/) {
    $area=$1;
    $switches=$2 if $2;
  } else {
    print STDERR "lstat <AREA> (?switch)\n";
    return;
  }
  if ($area=~/#(\d+)/) {
    $area=$realm{$1};
  }
  $switches=~s/^\?//;
  local(@switch)=split(/&/, $switches);

  printf "%10s %4s %-20s %-9s %3s  %3s %-11s\n", 'own', 'unit', 'Type', 'at(near)', 'eff', 'tech', 'date';
  local($unitcount)=0;
  foreach $unit (keys %unitown) {
    $fail=0;
    next unless (&in_realm($area, $unitsect{$unit}) | &in_realm($area, $unitnear{$unit}));
;
    @tmp=@switch;
    while($tmp=shift(@tmp)) {
      ($val, $op, $amt)=($tmp=~/^(\S+)([=\#<>])\"?(.+)\"?$/);
      if ($val eq 'eff') { $val=$uniteff{$unit}; }
      elsif ($val eq 'tech') { $val=$unittech{$unit}; }
      elsif ($val eq 'own') { 
        $val=$unitown{$unit};		#*# Untested
        if (!($amt=~/^\d+$/)) { $amt=$number{$amt}; }
      }
      elsif ($val eq 'type') { $val=substr($unitname{$unit},0,length($amt)); }
      else {
        print "Invalid switch $tmp\n";
        return;
      }
      if ($op eq '=') {
        if ($val ne $amt) { $fail=1; }
      } elsif ($op eq '#') {
        if ($val eq $amt) { $fail=1; }
      } elsif ($op eq '<') {
        if ($val>$amt) { $fail=1; }
      } elsif ($op eq '>') {
        if ($val<$amt) { $fail=1; }
      }
    }
    if ($fail==0) {
      $unitcount++;
      ($mon, $mday, $hour, $min)=($unitdate{$unit}=~
        /(\d+)\/(\d+) (\d+):(\d+)/);
      printf "%10s %4d %-20s %-9s %3s%% %3s %3s %2d %02d:%02d\n",
      $country{$unitown{$unit}}?substr($country{$unitown{$unit}},0,10):$unitown{$unit},
      $unit,
      $unitname{$unit},
      $unitsect{$unit} ? $unitsect{$unit} : "(" . $unitnear{$unit} . ")",
      $uniteff{$unit},
      $unittech{$unit},
      $main'monthname{$mon},
      $mday,
      $hour,
      $min;
    }
  }
  print "$unitcount Units.\n";
}
  
$main'functionmap{'pstat'}='&tools_pstat'; #'

sub tools_pstat {
  local(@switch, @equal, @less, @nequal, @great, @tmp, $amt, $val, $xy, $fail);
  if ($main'commandarg=~/\s*(\S+)\s*(.*)/) {
    $area=$1;
    $switches=$2 if $2;
  } else {
    print STDERR "pstat <AREA> (?switch)\n";
    return;
  }
  if ($area=~/#(\d+)/) {
    $area=$realm{$1};
  }
  $switches=~s/^\?//; 
  local(@switch)=split(/&/, $switches);

  printf "%10s %4s %-20s %-9s %3s  %3s %-11s\n", 'own', 'plane', 'Type', 'at(near)', 'eff', 'tech', 'date';
  local($planecount)=0;
  foreach $plane (keys %planeown) {
    $fail=0;
    next unless (&in_realm($area, $planesect{$plane}) | &in_realm($area, $planenear{$plane}));
    @tmp=@switch;
    while($tmp=shift(@tmp)) {
      ($val, $op, $amt)=($tmp=~/^(\S+)([=\#<>])\"?(.+)\"?$/);
      if ($val eq 'eff') { $val=$planeeff{$plane}; }
      elsif ($val eq 'tech') { $val=$planetech{$plane}; }
      elsif ($val eq 'own') { 		#*# Untested
        $val=$planeown{$plane}; 
        if (($amt=~/^\d+$/)) { $amt=$number{$amt}; }
      }
      elsif ($val eq 'type') { $val=substr($planename{$plane},0,length($amt)); }
      else {
        print "Invalid switch $tmp\n";
        return;
      }
      if ($op eq '=') {
        if ($val ne $amt) { $fail=1; }
      } elsif ($op eq '#') {
        if ($val eq $amt) { $fail=1; }
      } elsif ($op eq '<') {
        if ($val>$amt) { $fail=1; }
      } elsif ($op eq '>') {
        if ($val<$amt) { $fail=1; }
      }
    }
    if ($fail==0) {
      $planecount++;
      printf "%10s %4d %-20s %-9s %3s%% %3s %-11s\n",
      $country{$planeown{$plane}}?substr($country{$planeown{$plane}},0,10):$planeown{$plane},
      $plane,
      $planename{$plane},
      $planesect{$plane} ? $planesect{$plane} : "(" . $planenear{$plane} . ")",
      $planeeff{$plane},
      $planetech{$plane},
      $planedate{$plane};
    }
  }
  print "$planecount Planes.\n";
}

$main'functionmap{'sstat'}='&tools_sstat'; #'
sub tools_sstat {
  local(@switch, @equal, @less, @nequal, @great, @tmp, $amt, $val, $xy, $fail);
  local($mon, $mday, $hour, $min);
  if ($main'commandarg=~/\s*(\S+)\s*(.*)/) {
    $area=$1;
    $switches=$2 if $2;
  } else {
    print STDERR "sstat <AREA> (?switch)\n";
    return;
  }
  if ($area=~/#(\d+)/) {
    $area=$realm{$1};
  }
  $switches=~s/^\?//; 
  local(@switch)=split(/&/, $switches);

  printf "%10s %4s %-20s %-9s %3s  %3s %-11s\n", 'own', 'ship', 'Type', 'at(near)', 'eff', 'tech', 'date';
  local($shipcount)=0;
  foreach $ship (keys %shipown) {
    $fail=0;
    next unless (&in_realm($area, $shipsect{$ship}) | &in_realm($area, $shipnear{$ship}));
    @tmp=@switch;
    while($tmp=shift(@tmp)) {
      ($val, $op, $amt)=($tmp=~/^(\S+)([=\#<>])\"?(.+)\"?$/);
      if ($val eq 'eff') { $val=$shipeff{$ship}; }
      elsif ($val eq 'tech') { $val=$shiptech{$ship}; }
      elsif ($val eq 'own') { 		#*# Untested
        $val=$shipown{$ship};
        if (!($amt=~/^\d+$/)) { $amt=$number{$amt}; }
      }
      elsif ($val eq 'type') { $val=substr($shipname{$ship},0,length($amt)); }
      else {
        print "Invalid switch $tmp\n";
        return;
      }
      if ($op eq '=') {
        if ($val ne $amt) { $fail=1; }
      } elsif ($op eq '#') {
        if ($val eq $amt) { $fail=1; }
      } elsif ($op eq '<') {
        if ($val>$amt) { $fail=1; }
      } elsif ($op eq '>') {
        if ($val<$amt) { $fail=1; }
      }
    }
    if ($fail==0) {
      $shipcount++;
      ($mon, $mday, $hour, $min)=($shipdate{$ship}=~
        /(\d+)\/(\d+) (\d+):(\d+)/);
      printf "%10s %4d %-20s %-9s %3s%% %3s %3s %2d %02d:%02d\n",
      $country{$shipown{$ship}}?substr($country{$shipown{$ship}},0,10):$shipown{$ship},
      $ship,
      $shipname{$ship},
      $shipsect{$ship} ? $shipsect{$ship} : "(" . $shipnear{$ship} . ")",
      $shipeff{$ship},
      $shiptech{$ship},
      $main'monthname{$mon},
      $mday,
      $hour,
      $min;
    }
  }
  print "$shipcount Ships.\n";
}

# Makerealm returns a list of every sector in a realm.  Currently unused!!

sub makerealm {
  local($range)=@_;
  if ($range eq '*') { $range=join("","-$width/2:",$width/2-1,",-$height/2:",$height/2-1); }
  local($xrange, $yrange)=($range=~/(\S+)\,(\S+)/);
  local(@tmp)=split(/:/, $xrange);
  local($xmin)=shift(@tmp); local($xmax)=shift(@tmp);
  $xmax=$xmin unless $xmax;
  (@tmp)=split(/:/, $yrange);
  local($ymin)=shift(@tmp); local($ymax)=shift(@tmp);
  $ymax=$ymin unless $ymax;
  local($x, $y);
  $y=$ymin-1;
  do {
    $y++;
    $y=-1*$height/2 if $y>=$height/2;
    $x=$xmin-1;
    do {
      $x++;
      $x=-1*$width/2 if $x>=$width/2;
      push (@sects, "$x,$y") if $x%2==$y%2; 
    } until $x==$xmax;
  } until $y==$ymax;
  return @sects;
}

# todec converts 10K to 10000 and 10M to 10000000.  It is called in parse.pl,
# but I thought I should keep actual procedures out of parse.pl

sub todec {
  local($val)=@_;
  if ($val=~/(\d+\.?\d*)M/) {
    return $1*1000000;
  } elsif ($val=~/(\d+\.?\d*)K/) {
    return $1*1000;
  } else {
    return $val;
  } 
}

sub build_sect_target {
  local ($area) = @_;
  local ($x, $y);
  %target = ();

  $area = '*' unless $area;
  print STDERR "parsing dump $area...";
  print $main'S "dump $area\n"; #'
  $main'command = 'dump'; #'
  while (&getline) {
    ($x,$y) = split(/\s/,$_,3);
    $target{"$x,$y"} = 1 unless /^\d+ sectors?$/;
  }
  print STDERR "done\n";
}

sub build_ships_target {
  local ($ships) = @_;
  local ($id);
  %target = ();

  $ships = '*' unless $ships;
  print STDERR "parsing ship $ships...";
  print $main'S "ship $ships\n"; #'
  $main'command = 'ship'; #'
  while (&getline) {
    ($id) = split(/\s/,$_,2);
    $target{$id} = 1 unless /^\d+ ships?$/;
  }
  print STDERR "done\n";
}

sub build_lands_target {
  local ($lands) = @_;
  local ($id);
  %target = ();

  $lands = '*' unless $lands;
  print STDERR "parsing land $lands...";
  print $main'S "land $lands\n"; #'
  $main'command = 'land'; #'
  while (&getline) {
    ($id) = split(/\s/,$_,2);
    $target{$id} = 1 unless /^\d+ units?$/;
  }
  print STDERR "done\n";
}

sub print_n_parse {
  local ($line) = @_;
  print STDERR "parsing $line...";
  &main'parse_commandline($line.' >/dev/null'); #'
  print STDERR "done\n";
}


 sub letter_init {
 # Put this in any init (such as find_country_number) or maybe I'll add 
 #  &deity_init for deity stuff.
 
   # Adding in single letter country desig here, used in dmap
 
   local(%used, @tmp);
   local($done)=0;
   (@tmp)=keys %country;
   $y=0;
   while(!$done) {
     while($#tmp>-1) {
       $x=pop(@tmp);
       next if $deity{$x};
       if ($y>length($country{$x})-1) {
         push(@impossible, $x);
         next;
       }
       $test=&toupper(substr($country{$x},$y,1));
       if (!defined($used{$test})) {
 	$letter{$x}=$test;
 	$used{$test}=1;
       } else {
         if (!defined($used{&tolower(substr($country{$x},$y,1))})) {
 	  $test=&tolower(substr($country{$x},$y,1));
 	  if (!defined($used{$test})) {
 	    $letter{$x}=$test;
 	    $used{$test}=1;
 	  }
 	} else {
 	  push(@tmp2, $x); 
 	}
       }
     }
     @tmp=@tmp2 unless $#tmp2==-1;
     undef(@tmp2);
     $done=1 unless $#tmp>-1;
     $y++;
   }
   if ($#impossible>-1) {
     local($every)="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890";
     foreach $tmp (values %letter) {
       $every=~s/$tmp//;
     }
     local(@every)=split(//, $every);
     while($#impossible>-1) {
       $tmp=shift(@impossible);
       $letter{$tmp}=shift(@every);
     } 
   }
   if (defined($mycounnum)) {
     print STDERR "Your country number is $mycounnum\n";
     $main'coun=$mycounnum;
     return;
   }
 }
 
 
 $main'functionmap{'cmap'}='&tools_cmap';
 
 sub tools_cmap {
   local(@row, $pad, %onmap, $c, @list, $tmp, $line);
 
   local ($area) = $main'commandarg;
   &print_n_parse("realm");
   if ($area =~ /#(\d{1,2})/) {
     $area = $realm{$1};
   } elsif ($area eq '*') {
     $area=join('', "-", $width/2, ":", $width/2-1, ",-", $height/2, ":", $height/2-1);
   } else {
     $area = $realm{0};
   }
   &print_n_parse("bmap $area");
   &print_n_parse("cen $area");
   local($xrange, $yrange)=($area=~/(\S+),(\S+)/);
   local(@tmp)=split(/:/, $xrange);
   $xmin=shift(@tmp); $xmax=shift(@tmp);
   $xmax=$xmin unless $xmax;
   local(@tmp)=split(/:/, $yrange);
   $ymin=shift(@tmp); $ymax=shift(@tmp);
   $ymax=$ymin unless $ymax;
 
   $pad=substr("          ",0,length($height/2)+1);
   $x=$xmin-1;
   do {
     $x++;
     if ($x>$width/2-1) { print "after right x\n"; $x=$width/2*-1; }
     $xx=join("",substr("        ",0,length($width/2)+1-length($x)),$x);
     for($w=length($width/2)+1;$w>=0; $w--) {
       $row[$w].=substr($xx,$w,1);
     }
   } until $x==$xmax;
   for($w=0;$w<length($width/2)+1; $w++) {
     $row[$w]="$pad $row[$w]";
     print "$row[$w]\n";
   }
   $y=$ymin-1;
   do {
     $y++;
     $y=-1*$height/2 if $y>$height/2-1; 
     $x=$xmin-1;
     $pad=substr("         ",0,length($height/2)+1-length($y));
     do {
       $x++;
       $x=-1*$width/2 if $x>$width/2-1; 
       if (defined($dump{$x, $y, "des"})) {
         if ($dump{$x, $y, 'own'}==0 || $dump{$x, $y, 'own'}==$main'coun) {
 	  $line.=$dump{$x, $y, "des"};
         } else {
           $line.=$letter{$dump{$x, $y, 'own'}};
	   $onmap{$dump{$x, $y, 'own'}}=1;
         }
       } else {
         if (defined($bdes{$x, $y})) {
           $line.=$bdes{$x, $y};
         } else {
	   $line.=" ";
         }
       }
     } until $x==$xmax;
     print "$pad$y $line $y\n";
     $pad=""; $line=""; 
   } until $y==$ymax;
   for($w=0;$w<length($width/2)+1; $w++) {
     print "$row[$w]\n";
   }
   foreach $c (keys %onmap) {
     push(@list, sprintf("%15s=%s",$country{$c}, $letter{$c}));
   }
   while($#list>-1) {
     $line= pop(@list) . pop(@list) . pop(@list) . pop(@list);
     print "$line\n";
   }
 
 }
   
 sub tolower {
   local($in)=@_;
   local($out, $c, $x);
   local(%alpha)=('A','a','B','b','C','c','D','d','E','e','F','f','G','g','H','h','I','i','J','j','K','k','L','l','M','m','N','n','O','o','P','p','Q','q','R','r','S','s','T','t','U','u','V','v','W','w','X','x','Y','y','Z','z','1','1','2','2','3','3','4','4','5','5','6','6','7','7','8','8','9','9','0','0');
   $out="";
   for($x=0;$x<length($in);$x++) {
     $c=substr($in,$x,1);
     if ($alpha{$c}) {
       $out.=$alpha{$c};
     } else {
       $out.=$c;
     }
   }
   return $out;
 }
 sub toupper {
   local($in)=@_;
   local($out, $c, $x);
   local(%alpha)=('a','A','b','B','c','C','d','D','e','E','f','F','g','G','h','H','i','I','j','J','k','K','l','L','m','M','n','N','o','O','p','P','q','Q','r','R','s','S','t','T','u','U','v','V','w','W','x','X','y','Y','z','Z','1','1','2','2','3','3','4','4','5','5','6','6','7','7','8','8','9','9','0','0');
   $out="";
   for($x=0;$x<length($in);$x++) {
     $c=substr($in,$x,1);
     if ($alpha{$c}) {
       $out.=$alpha{$c};
     } else {
       $out.=$c;
     }
   }
   return $out;
 }
 
$main'tools_loaded = 1; #';