Commands/PA.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2008 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
  20 package NDIRC::Commands::PA;
  21
  22 use strict;
  23 use warnings;
  24 use feature ':5.10';
  25
  26 use Moose;
  27 use MooseX::MethodAttributes;
  28 use POSIX qw/pow/;
  29
  30 use NDIRC::Misc;
  31 use ND::Include;
  32
  33
  34 sub bcalc
  35         : Help(Lists bcalc and stats info)
  36 {
  37         my ($self, $c, $msg) = @_;
  38         $c->reply("http://game.planetarion.com/bcalc.pl http://game.planetarion.com/manual.php?page=stats");
  39 }
  40
  41 sub p
  42         : Help(usage: .p X:Y:Z | or .p nick with high enough access)
  43 {
  44         my ($self, $c, $msg) = @_;
  45
  46         my ($x,$y,$z,$nick);
  47         if ($msg =~ /(\d+)\D+(\d+)\D+(\d+)/){
  48                 $x = $1;
  49                 $y = $2;
  50                 $z = $3;
  51         }elsif ($msg && $c->check_user_roles(qw/irc_p_nick/)){
  52                 $nick = $msg;
  53         }else{
  54                 die "ARGS";
  55         }
  56
  57         my $f = $c->model->prepare(q{
  58 SELECT coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank,
  59         valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel
  60 FROM current_planet_stats WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4 LIMIT 1
  61         });
  62         $f->execute($x,$y,$z,$nick);
  63         if (my $planet = $f->fetchrow_hashref()){
  64                 for (keys %{$planet}){
  65                         $planet->{$_} = valuecolor(1,$planet->{$_});
  66                 }
  67                 my $ally = "";
  68                 if ($c->check_user_roles(qw/irc_p_intel/)){
  69                         $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},";
  70                 }
  71                 $c->reply("$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})");
  72         }else{
  73                 $c->reply("Couldn't find planet: $msg");
  74         }
  75 }
  76
  77 sub g
  78         : Help(usage: .g X:Y)
  79 {
  80         my ($self, $c, $msg) = @_;
  81
  82         my ($x,$y) = ($msg =~ /(\d+)\D+(\d+)/) or die 'ARGS';
  83
  84         my $f = $c->model->prepare(q{
  85 SELECT score,scorerank,size,sizerank,value,valuerank,planets
  86 FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies)
  87         });
  88         $f->execute($x,$y);
  89         while (my @row = $f->fetchrow()){
  90                 @row = map (valuecolor(1),@row);
  91                 $c->reply("$x:$y  Score=$row[0] ($row[1]), Size=$row[2] ($row[3]), Value=$row[4] ($row[5]), Planets=$row[6]");
  92         }
  93 }
  94
  95 sub time
  96         : Help(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.)
  97 {
  98         my ($self, $c, $msg) = @_;
  99         my ($tick,$timezone) = $msg =~ /^(\d+)?\s*(\S+)?$/ or die 'ARGS';
 100
 101         eval {
 102                 $tick //= $c->model->selectrow_array(q{SELECT tick()});
 103                 $timezone //= 'GMT';
 104                 my $query = $c->model->prepare(q{
 105 SELECT date_trunc('seconds',now() + (($1 - tick()) || ' hr')::interval) AT TIME ZONE $2
 106                         });
 107                 $query->execute($tick,$timezone);
 108                 my $time = $query->fetchrow_array;
 109                 $c->reply("Time at tick <b>$tick</b>, timezone <b>$timezone</b>: <b>$time</b>");
 110         };
 111         given ($@){
 112                 when(/time zone "(.+?)" not recognized/){
 113                         $c->reply("<c04>$1</c> is not a valid timezone.");
 114                 }
 115                 die $@ if $@;
 116         }
 117 }
 118
 119 sub xp
 120         : Help(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 cap according to your value)
 121 {
 122         my ($self, $c, $msg) = @_;
 123
 124         my ($x,$y,$z,$roids,$cap) = $msg =~ /^(\d+)\D+(\d+)\D+(\d+)(?:[^\.\d]+(\d+))?(?:[^\.\d]+(\d*\.\d+))?$/
 125                 or die 'ARGS';
 126
 127         my ($avalue,$ascore) = $c->model->selectrow_array(q{
 128 SELECT value,score FROM current_planet_stats
 129 WHERE pid = (SELECT pid FROM users WHERE hostmask ILIKE ?)
 130                 }, undef, $c->host);
 131         my ($tvalue,$tscore,$tsize) = $c->model->selectrow_array(q{
 132 SELECT value,score,size FROM current_planet_stats
 133 WHERE x = ? AND y = ? and z = ?
 134                 }, undef, $x,$y,$z);
 135         $cap //= min(0.25,0.25 * pow($tvalue/$avalue , 0.5));
 136         unless($roids){
 137                 $roids = int($tsize*$cap);
 138         }elsif ($roids < 10){
 139                 $tsize = int($tsize*.75**($roids-1));
 140                 $roids = int($cap*$tsize);
 141         }
 142         $tsize -= $roids;
 143         unless (defined $avalue && defined $ascore){
 144                 $c->reply("You don't have a planet specified");
 145                 return;
 146         }
 147         unless (defined $tvalue && defined $tscore){
 148                 $c->reply("No planet found at $x:$y:$z");
 149                 return;
 150         }
 151         my $xp = pa_xp($roids,$ascore,$avalue,$tscore,$tvalue);
 152         my $score = 60 * $xp;
 153         my $value = $roids*200;
 154         my $totscore = prettyValue($score + $value);
 155         $cap = sprintf "%.1f", $cap*100;
 156         $c->reply("You will gain <b>$xp</b> XP, <b>$score</b> score, if you steal <b>$roids</b> roids (<b>$value</b> value, <b>$cap%</b> cap), from <b>$x:$y:$z</b>, who will have <b>$tsize</b> roids left, total score gain will be: <b>$totscore</b> in total,");
 157 }
 158
 159 sub fco
 160         : Help(syntax: .fco agents stolen [tick] | 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)
 161 {
 162         my ($self, $c, $msg) = @_;
 163
 164         my ($agents,$stolen,$tick) = $msg =~ /^(\d+)\s+(\d+)\s*(\d+)?$/ or die 'ARGS';
 165
 166         $tick //= $c->model->selectrow_array(q{SELECT tick()});
 167
 168         my ($value,$score) = $c->model->selectrow_array(q{
 169 SELECT value,score FROM planet_stats WHERE tick = $2 AND
 170         pid = (SELECT pid FROM users WHERE hostmask ILIKE $1)
 171                 }, undef, $c->host,$tick);
 172         unless ($value){
 173                 $c->reply("You don't have a planet registered.");
 174                 return;
 175         }
 176         my $attackers = $c->model->prepare(q{
 177 SELECT coords(p.x,p.y,p.z), ruler, planet FROM current_planet_stats p
 178         JOIN planet_stats ps using (pid)
 179 WHERE ps.tick = $1 AND trunc(2000.0*$2*$3/ps.value)::int = $4
 180                 });
 181         $attackers->execute($tick,$agents,$value,$stolen);
 182         if ($attackers->rows == 0){
 183                 $c->reply("No cov opper found, did you specify the right tick, and was the stolen amount not capped?");
 184         }else{
 185                 my $coords = '';
 186                 while (my $attacker = $attackers->fetchrow_hashref){
 187                         $coords .= " ($attacker->{coords} : $attacker->{ruler} OF $attacker->{planet})";
 188                 }
 189                 $c->reply("The planet that cov opped you is one of: $coords");
 190         }
 191 }
 192
 193 sub eff
 194         : Alias(qw/veff stop vstop/)
 195         : Help( syntax: .eff 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) | veff, stop and vstop are variations of this command)
 196 {
 197         my ($self, $c, $msg) = @_;
 198         my ($amount,$ship,$target) = $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) (\w+)(?: (\w+))?/
 199                 or die 'ARGS';
 200
 201         my $eff = ($self->name =~ /(eff)/);
 202         $ship = "\%$ship\%";
 203         $target //= '%';
 204         my $value;
 205         if ($self->name =~ /^v.+$/){
 206                 $value = parseValue($amount);
 207                 $value *= -1.5 if $value < 0;
 208         }else{
 209                 $amount = parseValue($amount);
 210         }
 211
 212         my $feud = '';
 213
 214         my $s= $c->model->selectrow_hashref(q{
 215                 SELECT name,t1,t2,t3,"type",damage
 216                         ,metal+crystal+eonium AS cost
 217                         ,init,"class",guns,race,eres,armor
 218                 FROM ship_stats WHERE name ILIKE ?
 219                 }, undef, $ship);
 220         if ($s){
 221                 if (defined $value){
 222                         $amount = int(($value*100/$s->{cost}));
 223                         $feud = '(FEUD: '.prettyValue(int($amount/0.86)).') ';
 224                 }
 225                 $value = prettyValue(($amount*$s->{cost}/100));
 226                 my $name = shipColor($s->{name},$s->{type});
 227                 my $text = prettyValue($amount)." $name ($s->{init}:$value) :";
 228                 for my $tn ('t1','t2','t3'){
 229                         next if ($eff && not defined $s->{$tn});
 230                         $text .= " <b><c03>" . ($eff ? $s->{$tn} : $tn) . "</c></b>: ";
 231                         my $st = q{
 232                                 SELECT name,"class","type",armor
 233                                         ,metal+crystal+eonium AS cost
 234                                         ,init,t1,t2,t3,eres,race
 235                                         ,damage,guns
 236                                 FROM ship_stats
 237                         };
 238                         if ($eff){
 239                                 $st = $c->model->prepare($st . q{
 240                                 WHERE "class" = $1
 241                                         AND ("class" ILIKE $2 OR race ILIKE $2)
 242                                 });
 243                                 $st->execute($s->{$tn},$target);
 244                         }else{
 245                                 $st = $c->model->prepare($st . qq{
 246                                 WHERE $tn = \$1
 247                                         AND ("class" ILIKE \$2 OR race ILIKE \$2)
 248                                 });
 249                                 $st->execute($s->{class},$target);
 250                         }
 251                         while (my $t = $st->fetchrow_hashref()){
 252                                 my $number = calcEff($s,$t,$amount,$eff);
 253                                 if ($eff){
 254                                         $number *= 0.60 if $tn eq 't2';
 255                                         $number *= 0.30 if $tn eq 't3';
 256                                 }else{
 257                                         $number /= 0.60 if $tn eq 't2';
 258                                         $number /= 0.30 if $tn eq 't3';
 259                                 }
 260                                 $number = int($number);
 261                                 $value = prettyValue($number*$t->{cost}/100);
 262                                 my $name = shipColor($t->{name},$t->{type});
 263                                 $text .= " <b>$number</b> $name ($t->{init}:$value),";
 264                         }
 265                         chop $text;
 266                 }
 267                 $c->reply($text);
 268         }
 269 }
 270
 271 sub calcEff {
 272         my ($s,$t,$amount,$eff) = @_;
 273
 274         my $number = 0;
 275         if ($eff){
 276                 $number = $s->{type} eq 'Emp' ?
 277                         ($amount*$s->{guns}*(100-$t->{eres})/100)
 278                         : ($amount*$s->{damage}/$t->{armor});
 279         }else{
 280                 $number = $t->{type} eq 'Emp' ?
 281                         ($amount*100/(100 - $s->{eres})/$t->{guns})
 282                         : ($amount*$s->{armor}/$t->{damage});
 283         }
 284
 285         for my $tn ('t1','t2','t3'){
 286                 my ($s1,$t1) = $eff ? ($s,$t) : ($t,$s);
 287                 next unless (defined $t1->{$tn});
 288                 next unless ($t1->{$tn} eq $s1->{class});
 289
 290                 if($t1->{init} <= $s1->{init}){
 291                         $t->{init} = "<c04>$t->{init}</c>";
 292                 }else{
 293                         $t->{init} = "<c12>$t->{init}</c>";
 294                 }
 295         }
 296         return $number;
 297 }
 298
 299 sub shipColor {
 300         my ($string,$type) = @_;
 301         my $c = 04;
 302         $c = 12 if $type eq 'Emp';
 303         $c = 13 if $type eq 'Steal';
 304         return "<c$c>$string</c>";
 305 }
 306
 307 1;