Archived from groups: rec.games.empire (
More info?)
If you can read/run perl, give this a try. I'm not that proud of the
code, but it works. Just issue a 'prod *' to a file the program can
read.
Jay
#!perl
#
#
# Bank dust support
# Really need the dust on-hand, especially in the warehouse & the g
sector.
use strict;
use constant TRUE => 1;
use constant FALSE =>0;
my ($idx, $pct);
my $sect;
my $des;
my $eff;
my $avail;
my $make;
my $pe;
my $cost;
my $use1;
my $use2;
my $use3;
my $max1;
my $max2;
my $max3;
my $max;
my $making;
my ($make_iron, $max_make_iron) = (0,0);
my ($make_dust, $max_make_dust) = (0,0);
my ($make_oil, $max_make_oil) = (0,0);
my ($make_rad, $max_make_rad) = (0,0);
my ($make_lcm, $max_make_lcm) = (0,0);
my ($make_hcm, $max_make_hcm) = (0,0);
my ($make_edu, $max_make_edu) = (0,0);
my ($make_bar, $max_make_bar) = (0,0);
my ($make_gun, $max_make_gun) = (0,0);
my ($make_shell, $max_make_shell) = (0,0);
my ($make_mil, $max_make_mil) = (0,0);
my ($make_tech, $max_make_tech) = (0,0);
my ($make_research, $max_make_research) = (0,0);
my ($make_happy, $max_make_happy) = (0,0);
my ($use_iron, $use_dust, $use_oil, $use_lcm, $use_hcm) = (0,0,0,0,0);
my ($max_iron, $max_dust, $max_oil, $max_lcm, $max_hcm) = (0,0,0,0,0);
my ($tot_use_iron,$tot_use_dust,$tot_use_oil,$tot_use_lcm,$tot_use_hcm)
= (0,0,0,0,0);
my ($tot_max_iron,$tot_max_dust,$tot_max_oil,$tot_max_lcm,$tot_max_hcm)
= (0,0,0,0,0);
sub calc_use {
# Retutning: $use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil
my ($u1, $u2, $u3) = @_;
my ($using1, $using2, $using3);
my ($rtn_iron, $rtn_lcm, $rtn_hcm, $rtn_dust, $rtn_oil);
$rtn_iron=0; $rtn_lcm=0; $rtn_hcm=0; $rtn_dust=0; $rtn_oil=0;
if ( substr($u1, length($u1)-1, 1) =~ /[a-z]/ ) {
$using1=substr($u1, length($u1)-1, 1);
}
if ( substr($u2, length($u2)-1, 1) =~ /[a-z]/ ) {
$using2=substr($u2, length($u2)-1, 1);
}
if ( substr($u3, length($u3)-1, 1) =~ /[a-z]/ ) {
$using3=substr($u3, length($u3)-1, 1);
}
$u1=int($u1);
$u2=int($u2);
$u3=int($u3);
#print "u1[$using1]=($u1)\n";
#print "u2[$using2]=($u2)\n";
#print "u3[$using3]=($u3)\n";
if ( $using1 eq "i" ) { $rtn_iron += $u1; }
if ( $using2 eq "i" ) { $rtn_iron += $u2; }
if ( $using3 eq "i" ) { $rtn_iron += $u3; }
if ( $using1 eq "l" ) { $rtn_lcm += $u1; }
if ( $using2 eq "l" ) { $rtn_lcm += $u2; }
if ( $using3 eq "l" ) { $rtn_lcm += $u3; }
if ( $using1 eq "h" ) { $rtn_hcm += $u1; }
if ( $using2 eq "h" ) { $rtn_hcm += $u2; }
if ( $using3 eq "h" ) { $rtn_hcm += $u3; }
if ( $using1 eq "d" ) { $rtn_dust += $u1; }
if ( $using2 eq "d" ) { $rtn_dust += $u2; }
if ( $using3 eq "d" ) { $rtn_dust += $u3; }
if ( $using1 eq "o" ) { $rtn_oil += $u1; }
if ( $using2 eq "o" ) { $rtn_oil += $u2; }
if ( $using3 eq "o" ) { $rtn_oil += $u3; }
return ($rtn_iron, $rtn_lcm, $rtn_hcm, $rtn_dust, $rtn_oil);
}
sub calc_max {
# Retutning: $use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil
my ($m1, $m2, $m3) = @_;
my ($max2, $max2, $max3);
my ($rtn_iron, $rtn_lcm, $rtn_hcm, $rtn_dust, $rtn_oil);
$rtn_iron=0; $rtn_lcm=0; $rtn_hcm=0; $rtn_dust=0; $rtn_oil=0;
if ( substr($m1, length($m1)-1, 1) =~ /[a-z]/ ) {
$max1=substr($m1, length($m1)-1, 1);
}
if ( substr($m2, length($m2)-1, 1) =~ /[a-z]/ ) {
$max2=substr($m2, length($m2)-1, 1);
}
if ( substr($m3, length($m3)-1, 1) =~ /[a-z]/ ) {
$max3=substr($m3, length($m3)-1, 1);
}
$m1=int($m1);
$m2=int($m2);
$m3=int($m3);
#print "m1[$max1]=($m1)\n";
#print "m2[$max2]=($m2)\n";
#print "m3[$max3]=($m3)\n";
if ( $max1 eq "i" ) { $rtn_iron += $m1; }
if ( $max2 eq "i" ) { $rtn_iron += $m2; }
if ( $max3 eq "i" ) { $rtn_iron += $m3; }
if ( $max1 eq "l" ) { $rtn_lcm += $m1; }
if ( $max2 eq "l" ) { $rtn_lcm += $m2; }
if ( $max3 eq "l" ) { $rtn_lcm += $m3; }
if ( $max1 eq "h" ) { $rtn_hcm += $m1; }
if ( $max2 eq "h" ) { $rtn_hcm += $m2; }
if ( $max3 eq "h" ) { $rtn_hcm += $m3; }
if ( $max1 eq "d" ) { $rtn_dust += $m1; }
if ( $max2 eq "d" ) { $rtn_dust += $m2; }
if ( $max3 eq "d" ) { $rtn_dust += $m3; }
if ( $max1 eq "o" ) { $rtn_oil += $m1; }
if ( $max2 eq "o" ) { $rtn_oil += $m2; }
if ( $max3 eq "o" ) { $rtn_oil += $m3; }
return ($rtn_iron, $rtn_lcm, $rtn_hcm, $rtn_dust, $rtn_oil);
}
sub dispsummary {
my ($prodtype, $max_make, $make, $tot_use, $tot_max) = @_;
#("hcm", $max_make_hcm, $make_hcm, $tot_use_hcm, $tot_max_hcm)
#
if ( $prodtype eq "header" ) {
printf("%7s %11s %4s %11s %4s %12s_____%%\n",
"produce", "make/max", "%", "usage", "%", "max_usage__");
return;
}
if ( defined $max_make and $max_make > 0 ) {
$pct=int($make*100/$max_make)
}
else {
$pct=0;
}
printf("%7s %5d/%5d %3d%% ", $prodtype, $make, $max_make, $pct);
if ( defined $tot_use ) {
if ( defined $make and $make > 0 ) {
$pct=int($tot_use*100/$make);
}
else {
$pct=0;
}
printf("%5d/%5d %3d%% ", $tot_use, $make, $pct);
if ( defined $make and $make > 0 ) {
$pct=int($tot_max*100/$make);
}
else {
$pct=0;
}
printf("%5d/%5d\t%3d%%", $tot_max, $make, $pct);
}
print "\n";
}
sub main {
my $DumpFile="prod.new";
open(DUMP, "<$DumpFile") or do {
$DumpFile = "prod.last";
open(DUMP, "<$DumpFile") or die "Can't open dump file!";
};
print "File: $DumpFile\n";
$idx=0;
while ( <DUMP> ) {
++$idx;
my $desused='N';
$_ =~ s/[\n\r]//g;
next unless $idx > 3;
next if substr($_, 3, 7) eq "sectors";
$sect = substr($_,3,4);
$des = substr($_,10,1);
$eff = substr($_,12,3);
$avail = substr($_,17,5);
$make = substr($_,23,5);
$pe = substr($_,29,4);
$cost = substr($_,34,7); # Maybe 35,6 and strip the $ ??
$use1 = substr($_,40,5);
$use2 = substr($_,45,5);
$use3 = substr($_,50,5);
$max1 = substr($_,56,5);
$max2 = substr($_,61,5);
$max3 = substr($_,66,5);
$max = substr($_,72,5);
# Collect
undef $making;
if ( substr($make, length($make)-1, 1) =~ /[a-z]/ ) {
$making=substr($make, length($make)-1, 1);
}
if ( $making eq "i" ) { # or $des eq "m" # iron
$make_iron+=$make;
$max_make_iron+=$max;
}
elsif ( $making eq "d" ) { # or $des eq "g" # gold dust
$make_dust+=$make;
$max_make_dust+=$max;
}
elsif ( $making eq "o" ) { # or $des eq "g" # gold dust
$make_oil+=$make;
$max_make_oil+=$max;
}
elsif ( $making eq "r" ) { # or $des eq "u" # radiation
$make_rad+=$make;
$max_make_rad+=$max;
}
elsif ( $making eq "l" ) { # or $des eq "j" # lcm
$make_lcm+=$make;
$max_make_lcm+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_iron+=$use_iron;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_iron+=$max_iron;
}
elsif ( $making eq "h" ) { # or $des eq "k" # hcm
$make_hcm+=$make;
$max_make_hcm+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_iron+=$use_iron;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_iron+=$max_iron;
}
elsif ( $des eq "r" ) {
$make_research+=$make;
$max_make_research+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_lcm+=$use_lcm;
$tot_use_dust+=$use_dust;
$tot_use_oil+=$use_oil;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_lcm+=$max_lcm;
$tot_max_dust+=$max_dust;
$tot_max_oil+=$max_oil;
}
elsif ( $des eq "p" ) {
$make_happy+=$make;
$max_make_happy+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_lcm+=$use_lcm;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_lcm+=$max_lcm;
}
elsif ( $des eq "t" ) {
$make_tech+=$make;
$max_make_tech+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_lcm+=$use_lcm;
$tot_use_dust+=$use_dust;
$tot_use_oil+=$use_oil;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_lcm+=$max_lcm;
$tot_max_dust+=$max_dust;
$tot_max_oil+=$max_oil;
}
elsif ( $des eq "l" ) {
$make_edu+=$make;
$max_make_edu+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_lcm+=$use_lcm;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_lcm+=$max_lcm;
}
elsif ( $des eq "b" ) {
$make_bar+=$make;
$max_make_bar+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_dust+=$use_dust;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_dust+=$max_dust;
}
elsif ( $des eq "d" ) {
$make_gun+=$make;
$max_make_gun+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_oil+=$use_oil;
$tot_use_lcm+=$use_lcm;
$tot_use_hcm+=$use_hcm;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_oil+=$max_oil;
$tot_max_lcm+=$max_lcm;
$tot_max_hcm+=$max_hcm;
}
elsif ( $des eq "i" ) {
$make_shell+=$make;
$max_make_shell+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
$tot_use_lcm+=$use_lcm;
$tot_use_hcm+=$use_hcm;
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
$tot_max_lcm+=$max_lcm;
$tot_max_hcm+=$max_hcm;
}
elsif ( $des eq "e" ) {
$make_mil+=$make;
$max_make_mil+=$max;
($use_iron, $use_lcm, $use_hcm, $use_dust, $use_oil) =
calc_use($use1, $use2, $use3);
($max_iron, $max_lcm, $max_hcm, $max_dust, $max_oil) =
calc_max($max1, $max2, $max3);
}
else {
print "*************************> Unparsed: $des
<*************************\n";
}
}
if ( 1 == 1 ) {
# For commodities, need the dump to determin levels on hand.
dispsummary("header");
dispsummary("iron", $max_make_iron, $make_iron, $tot_use_iron,
$tot_max_iron);
dispsummary("oil", $max_make_oil, $make_oil, $tot_use_oil,
$tot_max_oil);
dispsummary("dust", $max_make_dust, $make_dust, $tot_use_dust,
$tot_max_dust);
dispsummary("lcm", $max_make_lcm, $make_lcm, $tot_use_lcm,
$tot_max_lcm);
dispsummary("hcm", $max_make_hcm, $make_hcm, $tot_use_hcm,
$tot_max_hcm);
dispsummary("bar", $max_make_bar, $make_bar);
dispsummary("rad", $max_make_rad, $make_rad);
dispsummary("happy", $max_make_happy, $make_happy);
dispsummary("guns", $max_make_gun, $make_gun);
dispsummary("shells", $max_make_shell, $make_shell);
dispsummary("mil", $max_make_mil, $make_mil);
dispsummary("edu", $max_make_edu, $make_edu);
dispsummary("tech", $max_make_tech, $make_tech);
}
close(DUMP);
if ( $DumpFile eq "prod.new" ) {
unlink "prod.last";
rename "prod.new", "botdata/prod.last" or die "$!";
print "Renamed file to .last\n";
}
}
main();