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