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