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() && defined $msg){
  42                 $nick = $msg;
  43         }else{
  44                 $ND::server->command("notice $ND::nick usage .p X:Y:Z".(officer() ? ' 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() || 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("SELECT score,size,value FROM galaxies WHERE x = ? AND y = ? and tick = (SELECT max(tick) from galaxies)");
  76         $f->execute($x,$y);
  77         while (my @row = $f->fetchrow()){
  78                 @row = map (valuecolor(1),@row);
  79                 $ND::server->command("notice $ND::nick $x:$y  Score=$row[0], Size=$row[1], Value=$row[2]");
  80         }
  81 }
  82
  83 sub shipEff {
  84         my ($msg,$command) = @_;
  85         my ($amount,$ship,$value,$target);
  86         my $eff = 1;
  87         $eff = 0 if $command =~ /stop/;
  88         if(defined $msg && $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) (\w+)(?: (\w+))?/){
  89                 $ship = "\%$2\%";
  90                 $target = ($3 || '%');
  91                 my $am = $1;
  92                 if ($command =~ /^v.+$/){
  93                         $value = parseValue($am);
  94                         $value *= -1.5 if $value < 0;
  95                         my $feud = '';
  96                 }else{
  97                         $amount = parseValue($am);
  98                 }
  99         }else{
 100                 $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)");
 101                 return;
 102         }
 103         my $feud = '';
 104
 105         my $s= $ND::DBH->selectrow_hashref(q{
 106                 SELECT name,t1,t2,t3,"type",damage
 107                         ,metal+crystal+eonium AS cost
 108                         ,init,"class",guns,race,eres,armor
 109                 FROM ship_stats WHERE name ILIKE ?
 110                 }, undef, $ship);
 111         if ($s){
 112                 if (defined $value){
 113                         $amount = int(($value*100/$s->{cost}));
 114                         $feud = '(FEUD: '.prettyValue(int($amount/0.85)).') ';
 115                 }
 116                 $value = prettyValue(($amount*$s->{cost}/100));
 117                 my $name = shipColor($s->{name},$s->{type});
 118                 my $text = prettyValue($amount)." $name ($s->{init}:$value) :";
 119                 for my $tn ('t1','t2','t3'){
 120                         next if ($eff && not defined $s->{$tn});
 121                         $text .= " $ND::B${ND::C}03" . ($eff ? $s->{$tn} : $tn) . "$ND::O: ";
 122                         my $st = q{
 123                                 SELECT name,"class","type",armor
 124                                         ,metal+crystal+eonium AS cost
 125                                         ,init,t1,t2,t3,eres,race
 126                                         ,damage,guns
 127                                 FROM ship_stats
 128                                 };
 129                         if ($eff){
 130                                 $st = $ND::DBH->prepare($st . q{
 131                                 WHERE "class" = $1
 132                                         AND ("class" ILIKE $2 OR race ILIKE $2)
 133                                 });
 134                                 $st->execute($s->{$tn},$target);
 135                         }else{
 136                                 $st = $ND::DBH->prepare($st . qq{
 137                                 WHERE $tn = \$1
 138                                         AND ("class" ILIKE \$2 OR race ILIKE \$2)
 139                                 });
 140                                 $st->execute($s->{class},$target);
 141                         }
 142                         while (my $t = $st->fetchrow_hashref()){
 143                                 my $number = calcEff($s,$t,$amount,$eff);
 144                                 $value = prettyValue($number*$t->{cost}/100);
 145                                 my $name = shipColor($t->{name},$t->{type});
 146                                 $text .= " $ND::B$number$ND::O $name ($t->{init}:$value),";
 147                         }
 148                         chop $text;
 149                 }
 150                 $ND::server->command("notice $ND::nick $text");
 151         }
 152 }
 153
 154 sub calcEff {
 155         my ($s,$t,$amount,$eff) = @_;
 156
 157         my $number = 0;
 158         if ($eff){
 159                 $number = $s->{type} eq 'Emp' ?
 160                         int($amount*$s->{guns}*(100-$t->{eres})/100)
 161                         : int($amount*$s->{damage}/$t->{armor});
 162         }else{
 163                 $number = $t->{type} eq 'Emp' ?
 164                         int($amount*100/(100 - $s->{eres})/$t->{guns})
 165                         : int($amount*$s->{armor}/$t->{damage});
 166         }
 167
 168         for my $tn ('t1','t2','t3'){
 169                 my ($s1,$t1) = $eff ? ($s,$t) : ($t,$s);
 170                 next unless (defined $t1->{$tn});
 171                 next unless ($t1->{$tn} eq $s1->{class});
 172
 173                 if($t1->{init} <= $s1->{init}){
 174                         $t->{init} = "${ND::C}04$t->{init}$ND::O";
 175                 }else{
 176                         $t->{init} = "${ND::C}12$t->{init}$ND::O";
 177                 }
 178         }
 179         return $number;
 180 }
 181
 182 sub shipColor {
 183         my ($string,$type) = @_;
 184         my $c = 04;
 185         $c = 12 if $type eq 'Emp';
 186         $c = 13 if $type eq 'Steal';
 187         return "$ND::C$c$string$ND::O";
 188 }
 189
 190 sub calcXp {
 191         my ($msg) = @_;
 192
 193         my ($x,$y,$z,$roids,$cap);
 194         if(defined $msg && $msg =~ /^(\d+)\D+(\d+)\D+(\d+)(?:[^\.\d]+(\d+))?(?:[^\.\d]+(\d*\.\d+))?$/){
 195                 $x = $1;
 196                 $y = $2;
 197                 $z = $3;
 198                 $roids = $4;
 199                 $cap = $5;
 200         }else{
 201                 $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");
 202                 return;
 203         }
 204
 205         my ($avalue,$ascore) = $ND::DBH->selectrow_array(q{
 206                 SELECT value,score FROM current_planet_stats WHERE
 207                         id = (SELECT planet FROM users WHERE hostmask ILIKE ?);
 208                 }, undef, $ND::address);
 209         my ($tvalue,$tscore,$tsize) = $ND::DBH->selectrow_array(q{
 210                 SELECT value,score,size FROM current_planet_stats WHERE
 211                 x = ? AND y = ? and z = ?;
 212                 }, undef, $x,$y,$z);
 213         $cap = 0.25 unless $cap;
 214         unless($roids){
 215                 $roids = int($tsize*$cap);
 216         }elsif ($roids < 10){
 217                 $tsize = ceil($tsize*.75**($roids-1));
 218                 $roids = int($cap*$tsize);
 219         }
 220         $tsize -= $roids;
 221         unless (defined $avalue && defined $ascore){
 222                 $ND::server->command("notice $ND::nick You don't have a planet specified");
 223                 return;
 224         }
 225         unless (defined $tvalue && defined $tscore){
 226                 $ND::server->command("notice $ND::nick Doesn't seem to be a planet at $x:$y:$z");
 227                 return;
 228         }
 229         my $xp = pa_xp($roids,$ascore,$avalue,$tscore,$tvalue);
 230         my $score = 60 * $xp;
 231         my $value = $roids*200;
 232         my $totscore = prettyValue($score + $value);
 233         $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,");
 234 }
 235
 236 sub findCovOpper {
 237         my ($stolen, $command) = @_;
 238
 239         my $tick = $ND::tick;
 240         my $agents;
 241
 242         if (defined $stolen && $stolen =~ /(\d+) (\d+) (\d+)/){
 243                 $tick = $1;
 244                 $agents = $2;
 245                 $stolen = $3;
 246         }elsif (defined $stolen && $stolen =~ /(\d+) (\d+)/){
 247                 $agents = $1;
 248                 $stolen = $2;
 249         }else{
 250                 $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");
 251                 return;
 252         }
 253
 254         my ($value,$score) = $ND::DBH->selectrow_array(q{
 255                 SELECT value,score FROM planet_stats WHERE
 256                         id = (SELECT planet FROM users WHERE hostmask ILIKE ?) AND tick = ?;
 257                 }, undef, $ND::address,$tick);
 258         unless ($value){
 259                 $ND::server->command("notice $ND::nick No value found for tick $tick, can't find your cov opper.");
 260                 return;
 261         }
 262         my $attackers = $ND::DBH->prepare(q{
 263                 SELECT coords(p.x,p.y,p.z), ruler, planet FROM current_planet_stats p JOIN planet_stats ps using (id) WHERE
 264                 ps.tick = $1 AND (2000*$2*$3/ps.value)::int = $4 ;
 265                 });
 266         $attackers->execute($tick,$agents,$value,$stolen);
 267         if ($attackers->rows == 0){
 268                 $ND::server->command("notice $ND::nick No cov opper found, did you specify the right tick, and was the stolen amount not capped?");
 269                 return;
 270         }
 271         my $coords = '';
 272         while (my $attacker = $attackers->fetchrow_hashref){
 273                 $coords .= " ($attacker->{coords} : $attacker->{ruler} OF $attacker->{planet})";
 274         }
 275         $ND::server->command("notice $ND::nick The planet that cov opped you is one of: $coords");
 276 }
 277
 278 1;