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                                 if ($eff){
 145                                         $number *= 0.60 if $tn eq 't2';
 146                                         $number *= 0.30 if $tn eq 't3';
 147                                 }else{
 148                                         $number /= 0.60 if $tn eq 't2';
 149                                         $number /= 0.30 if $tn eq 't3';
 150                                 }
 151                                 $number = int($number);
 152                                 $value = prettyValue($number*$t->{cost}/100);
 153                                 my $name = shipColor($t->{name},$t->{type});
 154                                 $text .= " $ND::B$number$ND::O $name ($t->{init}:$value),";
 155                         }
 156                         chop $text;
 157                 }
 158                 $ND::server->command("notice $ND::nick $text");
 159         }
 160 }
 161
 162 sub calcEff {
 163         my ($s,$t,$amount,$eff) = @_;
 164
 165         my $number = 0;
 166         if ($eff){
 167                 $number = $s->{type} eq 'Emp' ?
 168                         ($amount*$s->{guns}*(100-$t->{eres})/100)
 169                         : ($amount*$s->{damage}/$t->{armor});
 170         }else{
 171                 $number = $t->{type} eq 'Emp' ?
 172                         ($amount*100/(100 - $s->{eres})/$t->{guns})
 173                         : ($amount*$s->{armor}/$t->{damage});
 174         }
 175
 176         for my $tn ('t1','t2','t3'){
 177                 my ($s1,$t1) = $eff ? ($s,$t) : ($t,$s);
 178                 next unless (defined $t1->{$tn});
 179                 next unless ($t1->{$tn} eq $s1->{class});
 180
 181                 if($t1->{init} <= $s1->{init}){
 182                         $t->{init} = "${ND::C}04$t->{init}$ND::O";
 183                 }else{
 184                         $t->{init} = "${ND::C}12$t->{init}$ND::O";
 185                 }
 186         }
 187         return $number;
 188 }
 189
 190 sub shipColor {
 191         my ($string,$type) = @_;
 192         my $c = 04;
 193         $c = 12 if $type eq 'Emp';
 194         $c = 13 if $type eq 'Steal';
 195         return "$ND::C$c$string$ND::O";
 196 }
 197
 198 sub calcXp {
 199         my ($msg) = @_;
 200
 201         my ($x,$y,$z,$roids,$cap);
 202         if(defined $msg && $msg =~ /^(\d+)\D+(\d+)\D+(\d+)(?:[^\.\d]+(\d+))?(?:[^\.\d]+(\d*\.\d+))?$/){
 203                 $x = $1;
 204                 $y = $2;
 205                 $z = $3;
 206                 $roids = $4;
 207                 $cap = $5;
 208         }else{
 209                 $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");
 210                 return;
 211         }
 212
 213         my ($avalue,$ascore) = $ND::DBH->selectrow_array(q{
 214                 SELECT value,score FROM current_planet_stats WHERE
 215                         id = (SELECT planet FROM users WHERE hostmask ILIKE ?);
 216                 }, undef, $ND::address);
 217         my ($tvalue,$tscore,$tsize) = $ND::DBH->selectrow_array(q{
 218                 SELECT value,score,size FROM current_planet_stats WHERE
 219                 x = ? AND y = ? and z = ?;
 220                 }, undef, $x,$y,$z);
 221         $cap = 0.25 unless $cap;
 222         unless($roids){
 223                 $roids = int($tsize*$cap);
 224         }elsif ($roids < 10){
 225                 $tsize = ceil($tsize*.75**($roids-1));
 226                 $roids = int($cap*$tsize);
 227         }
 228         $tsize -= $roids;
 229         unless (defined $avalue && defined $ascore){
 230                 $ND::server->command("notice $ND::nick You don't have a planet specified");
 231                 return;
 232         }
 233         unless (defined $tvalue && defined $tscore){
 234                 $ND::server->command("notice $ND::nick Doesn't seem to be a planet at $x:$y:$z");
 235                 return;
 236         }
 237         my $xp = pa_xp($roids,$ascore,$avalue,$tscore,$tvalue);
 238         my $score = 60 * $xp;
 239         my $value = $roids*200;
 240         my $totscore = prettyValue($score + $value);
 241         $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,");
 242 }
 243
 244 sub findCovOpper {
 245         my ($stolen, $command) = @_;
 246
 247         my $tick = $ND::tick;
 248         my $agents;
 249
 250         if (defined $stolen && $stolen =~ /(\d+) (\d+) (\d+)/){
 251                 $tick = $1;
 252                 $agents = $2;
 253                 $stolen = $3;
 254         }elsif (defined $stolen && $stolen =~ /(\d+) (\d+)/){
 255                 $agents = $1;
 256                 $stolen = $2;
 257         }else{
 258                 $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");
 259                 return;
 260         }
 261
 262         my ($value,$score) = $ND::DBH->selectrow_array(q{
 263                 SELECT value,score FROM planet_stats WHERE
 264                         id = (SELECT planet FROM users WHERE hostmask ILIKE ?) AND tick = ?;
 265                 }, undef, $ND::address,$tick);
 266         unless ($value){
 267                 $ND::server->command("notice $ND::nick No value found for tick $tick, can't find your cov opper.");
 268                 return;
 269         }
 270         my $attackers = $ND::DBH->prepare(q{
 271                 SELECT coords(p.x,p.y,p.z), ruler, planet FROM current_planet_stats p JOIN planet_stats ps using (id) WHERE
 272                 ps.tick = $1 AND (2000.0*$2*$3/ps.value)::int = $4 ;
 273                 });
 274         $attackers->execute($tick,$agents,$value,$stolen);
 275         if ($attackers->rows == 0){
 276                 $ND::server->command("notice $ND::nick No cov opper found, did you specify the right tick, and was the stolen amount not capped?");
 277                 return;
 278         }
 279         my $coords = '';
 280         while (my $attacker = $attackers->fetchrow_hashref){
 281                 $coords .= " ($attacker->{coords} : $attacker->{ruler} OF $attacker->{planet})";
 282         }
 283         $ND::server->command("notice $ND::nick The planet that cov opped you is one of: $coords");
 284 }
 285
 286 1;