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