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