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