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