PA.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2006 by Michael Andreen <harvATruinDOTnu>               *
   3 #                                                                         *
   4 #   This program is free software; you can redistribute it and/or modify  *
   5 #   it under the terms of the GNU General Public License as published by  *
   6 #   the Free Software Foundation; either version 2 of the License, or     *
   7 #   (at your option) any later version.                                   *
   8 #                                                                         *
   9 #   This program is distributed in the hope that it will be useful,       *
  10 #   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
  11 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
  12 #   GNU General Public License for more details.                          *
  13 #                                                                         *
  14 #   You should have received a copy of the GNU General Public License     *
  15 #   along with this program; if not, write to the                         *
  16 #   Free Software Foundation, Inc.,                                       *
  17 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
  18 #**************************************************************************/
  19 package NDIRC::PA;
  20 use strict;
  21 use warnings;
  22 use ND::DB;
  23 use ND::Include;
  24 use NDIRC::Access;
  25 use NDIRC::Misc;
  26 use POSIX;
  27 require Exporter;
  28
  29 our @ISA = qw/Exporter/;
  30
  31 our @EXPORT = qw/checkPlanet checkGal shipEff shipStop parseValue prettyValue calcXp findCovOpper/;
  32
  33 sub checkPlanet {
  34         my ($msg) = @_;
  35
  36         my ($x,$y,$z,$nick);
  37         if ($msg =~ /(\d+)\D+(\d+)\D+(\d+)/){
  38                 $x = $1;
  39                 $y = $2;
  40                 $z = $3;
  41         }elsif ((officer() || ia()) && defined $msg){
  42                 $nick = $msg;
  43         }else{
  44                 $ND::server->command("notice $ND::nick usage .p X:Y:Z".(officer() || ia() ? ' or .p nick' : ''));
  45                 return;
  46         }
  47         my $f = $ND::DBH->prepare(q{SELECT coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank,
  48                 valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel
  49                 FROM current_planet_stats WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4 LIMIT 1
  50         });
  51         $f->execute($x,$y,$z,$nick);
  52         if (my $planet = $f->fetchrow_hashref()){
  53                 for (keys %{$planet}){
  54                         $planet->{$_} = valuecolor(1,$planet->{$_});
  55                 }
  56                 my $ally = "";
  57                 if (officer() || ia() || dc()){
  58                         $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},";
  59                 }
  60                 $ND::server->command("notice $ND::nick $planet->{coords} $planet->{ruler} OF $planet->{planet},$ally Race=$planet->{race}, Score=$planet->{score} ($planet->{scorerank}), Size=$planet->{size} ($planet->{sizerank}), Value=$planet->{value} ($planet->{valuerank}), XP=$planet->{xp} ($planet->{xprank})");
  61         }else{
  62                 $ND::server->command("notice $ND::nick Couldn't find planet: $msg");
  63         }
  64 }
  65 sub checkGal {
  66         my ($msg) = @_;
  67
  68         my ($x,$y,);
  69         if ($msg =~ /(\d+)\D+(\d+)/){
  70                 $x = $1;
  71                 $y = $2;
  72         }else{
  73                 $ND::server->command("notice $ND::nick syntax: .g X:Y");
  74         }
  75         my $f = $ND::DBH->prepare(q{SELECT score,scorerank,size,sizerank,value,valuerank,planets
  76                 FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies)
  77         });
  78         $f->execute($x,$y);
  79         while (my @row = $f->fetchrow()){
  80                 @row = map (valuecolor(1),@row);
  81                 $ND::server->command("notice $ND::nick $x:$y  Score=$row[0] ($row[1]), Size=$row[2] ($row[3]), Value=$row[4] ($row[5]), Planets=$row[6]");
  82         }
  83 }
  84
  85 sub shipEff {
  86         my ($msg,$command) = @_;
  87         my ($amount,$ship,$value,$target);
  88         my $eff = 1;
  89         $eff = 0 if $command =~ /stop/;
  90         if(defined $msg && $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) (\w+)(?: (\w+))?/){
  91                 $ship = "\%$2\%";
  92                 $target = ($3 || '%');
  93                 my $am = $1;
  94                 if ($command =~ /^v.+$/){
  95                         $value = parseValue($am);
  96                         $value *= -1.5 if $value < 0;
  97                         my $feud = '';
  98                 }else{
  99                         $amount = parseValue($am);
 100                 }
 101         }else{
 102                 $ND::server->command("notice $ND::nick syntax: $command amount ship [race|class] | Amount can use SI prefixes like k and M. Race or class is an optional argument, using the short form (i.e. cath or Fi)");
 103                 return;
 104         }
 105         my $feud = '';
 106
 107         my $s= $ND::DBH->selectrow_hashref(q{
 108                 SELECT name,t1,t2,t3,"type",damage
 109                         ,metal+crystal+eonium AS cost
 110                         ,init,"class",guns,race,eres,armor
 111                 FROM ship_stats WHERE name ILIKE ?
 112                 }, undef, $ship);
 113         if ($s){
 114                 if (defined $value){
 115                         $amount = int(($value*100/$s->{cost}));
 116                         $feud = '(FEUD: '.prettyValue(int($amount/0.85)).') ';
 117                 }
 118                 $value = prettyValue(($amount*$s->{cost}/100));
 119                 my $name = shipColor($s->{name},$s->{type});
 120                 my $text = prettyValue($amount)." $name ($s->{init}:$value) :";
 121                 for my $tn ('t1','t2','t3'){
 122                         next if ($eff && not defined $s->{$tn});
 123                         $text .= " $ND::B${ND::C}03" . ($eff ? $s->{$tn} : $tn) . "$ND::O: ";
 124                         my $st = q{
 125                                 SELECT name,"class","type",armor
 126                                         ,metal+crystal+eonium AS cost
 127                                         ,init,t1,t2,t3,eres,race
 128                                         ,damage,guns
 129                                 FROM ship_stats
 130                                 };
 131                         if ($eff){
 132                                 $st = $ND::DBH->prepare($st . q{
 133                                 WHERE "class" = $1
 134                                         AND ("class" ILIKE $2 OR race ILIKE $2)
 135                                 });
 136                                 $st->execute($s->{$tn},$target);
 137                         }else{
 138                                 $st = $ND::DBH->prepare($st . qq{
 139                                 WHERE $tn = \$1
 140                                         AND ("class" ILIKE \$2 OR race ILIKE \$2)
 141                                 });
 142                                 $st->execute($s->{class},$target);
 143                         }
 144                         while (my $t = $st->fetchrow_hashref()){
 145                                 my $number = calcEff($s,$t,$amount,$eff);
 146                                 if ($eff){
 147                                         $number *= 0.60 if $tn eq 't2';
 148                                         $number *= 0.30 if $tn eq 't3';
 149                                 }else{
 150                                         $number /= 0.60 if $tn eq 't2';
 151                                         $number /= 0.30 if $tn eq 't3';
 152                                 }
 153                                 $number = int($number);
 154                                 $value = prettyValue($number*$t->{cost}/100);
 155                                 my $name = shipColor($t->{name},$t->{type});
 156                                 $text .= " $ND::B$number$ND::O $name ($t->{init}:$value),";
 157                         }
 158                         chop $text;
 159                 }
 160                 $ND::server->command("notice $ND::nick $text");
 161         }
 162 }
 163
 164 sub calcEff {
 165         my ($s,$t,$amount,$eff) = @_;
 166
 167         my $number = 0;
 168         if ($eff){
 169                 $number = $s->{type} eq 'Emp' ?
 170                         ($amount*$s->{guns}*(100-$t->{eres})/100)
 171                         : ($amount*$s->{damage}/$t->{armor});
 172         }else{
 173                 $number = $t->{type} eq 'Emp' ?
 174                         ($amount*100/(100 - $s->{eres})/$t->{guns})
 175                         : ($amount*$s->{armor}/$t->{damage});
 176         }
 177
 178         for my $tn ('t1','t2','t3'){
 179                 my ($s1,$t1) = $eff ? ($s,$t) : ($t,$s);
 180                 next unless (defined $t1->{$tn});
 181                 next unless ($t1->{$tn} eq $s1->{class});
 182
 183                 if($t1->{init} <= $s1->{init}){
 184                         $t->{init} = "${ND::C}04$t->{init}$ND::O";
 185                 }else{
 186                         $t->{init} = "${ND::C}12$t->{init}$ND::O";
 187                 }
 188         }
 189         return $number;
 190 }
 191
 192 sub shipColor {
 193         my ($string,$type) = @_;
 194         my $c = 04;
 195         $c = 12 if $type eq 'Emp';
 196         $c = 13 if $type eq 'Steal';
 197         return "$ND::C$c$string$ND::O";
 198 }
 199
 200 sub calcXp {
 201         my ($msg) = @_;
 202
 203         my ($x,$y,$z,$roids,$cap);
 204         if(defined $msg && $msg =~ /^(\d+)\D+(\d+)\D+(\d+)(?:[^\.\d]+(\d+))?(?:[^\.\d]+(\d*\.\d+))?$/){
 205                 $x = $1;
 206                 $y = $2;
 207                 $z = $3;
 208                 $roids = $4;
 209                 $cap = $5;
 210         }else{
 211                 $ND::server->command("notice $ND::nick syntax: .xp X:Y:Z [roids] [cap] | if roids < 10 then it's taken as the wave, cap is a floating point number, defaults to 0.25");
 212                 return;
 213         }
 214
 215         my ($avalue,$ascore) = $ND::DBH->selectrow_array(q{
 216                 SELECT value,score FROM current_planet_stats WHERE
 217                         id = (SELECT planet FROM users WHERE hostmask ILIKE ?);
 218                 }, undef, $ND::address);
 219         my ($tvalue,$tscore,$tsize) = $ND::DBH->selectrow_array(q{
 220                 SELECT value,score,size FROM current_planet_stats WHERE
 221                 x = ? AND y = ? and z = ?;
 222                 }, undef, $x,$y,$z);
 223         $cap = 0.25 unless $cap;
 224         unless($roids){
 225                 $roids = int($tsize*$cap);
 226         }elsif ($roids < 10){
 227                 $tsize = ceil($tsize*.75**($roids-1));
 228                 $roids = int($cap*$tsize);
 229         }
 230         $tsize -= $roids;
 231         unless (defined $avalue && defined $ascore){
 232                 $ND::server->command("notice $ND::nick You don't have a planet specified");
 233                 return;
 234         }
 235         unless (defined $tvalue && defined $tscore){
 236                 $ND::server->command("notice $ND::nick Doesn't seem to be a planet at $x:$y:$z");
 237                 return;
 238         }
 239         my $xp = pa_xp($roids,$ascore,$avalue,$tscore,$tvalue);
 240         my $score = 60 * $xp;
 241         my $value = $roids*200;
 242         my $totscore = prettyValue($score + $value);
 243         $ND::server->command("notice $ND::nick You will gain $ND::B$xp$ND::B XP, $ND::B$score$ND::B score, if you steal $roids roids ($ND::B$value$ND::B value), from $ND::B$x:$y:$z$ND::B, who will have $ND::B$tsize$ND::B roids left, total score gain will be: $ND::B$totscore$ND::B in total,");
 244 }
 245
 246 sub findCovOpper {
 247         my ($stolen, $command) = @_;
 248
 249         my $tick = $ND::tick;
 250         my $agents;
 251
 252         if (defined $stolen && $stolen =~ /(\d+) (\d+) (\d+)/){
 253                 $tick = $1;
 254                 $agents = $2;
 255                 $stolen = $3;
 256         }elsif (defined $stolen && $stolen =~ /(\d+) (\d+)/){
 257                 $agents = $1;
 258                 $stolen = $2;
 259         }else{
 260                 $ND::server->command("notice $ND::nick syntax: .$command [tick] agents stolen | tick can be omitted if you're doing this the same tick you got cov opped, if you have different amount of your resources stolen, specify the highest amount. Only works if less than 10% of your resources and < 10,000*agents were stolen");
 261                 return;
 262         }
 263
 264         my ($value,$score) = $ND::DBH->selectrow_array(q{
 265                 SELECT value,score FROM planet_stats WHERE
 266                         id = (SELECT planet FROM users WHERE hostmask ILIKE ?) AND tick = ?;
 267                 }, undef, $ND::address,$tick);
 268         unless ($value){
 269                 $ND::server->command("notice $ND::nick No value found for tick $tick, can't find your cov opper.");
 270                 return;
 271         }
 272         my $attackers = $ND::DBH->prepare(q{
 273                 SELECT coords(p.x,p.y,p.z), ruler, planet FROM current_planet_stats p JOIN planet_stats ps using (id) WHERE
 274                 ps.tick = $1 AND (2000.0*$2*$3/ps.value)::int = $4 ;
 275                 });
 276         $attackers->execute($tick,$agents,$value,$stolen);
 277         if ($attackers->rows == 0){
 278                 $ND::server->command("notice $ND::nick No cov opper found, did you specify the right tick, and was the stolen amount not capped?");
 279                 return;
 280         }
 281         my $coords = '';
 282         while (my $attacker = $attackers->fetchrow_hashref){
 283                 $coords .= " ($attacker->{coords} : $attacker->{ruler} OF $attacker->{planet})";
 284         }
 285         $ND::server->command("notice $ND::nick The planet that cov opped you is one of: $coords");
 286 }
 287
 288 1;