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