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 use strict;
  21 use warnings;
  22 use feature ':5.10';
  23
  24 use MooseX::Declare;
  25 use NDIRC::Dispatcher;
  26
  27 command bcalc => {
  28         help => q(Lists bcalc and stats info),
  29 }, class extends NDIRC::Command {
  30         method execute($c,$msg) {
  31                 $c->reply("http://game.planetarion.com/bcalc.pl http://game.planetarion.com/manual.php?page=stats");
  32         }
  33 };
  34
  35 command p => {
  36         help => q(usage: .p X:Y:Z | or .p nick with high enough access),
  37 }, class extends NDIRC::Command {
  38         method execute($c,$msg) {
  39
  40                 my ($x,$y,$z,$nick);
  41                 if ($msg =~ /(\d+)\D+(\d+)\D+(\d+)/){
  42                         $x = $1;
  43                         $y = $2;
  44                         $z = $3;
  45                 }elsif ($msg && $c->check_user_roles(qw/irc_p_nick/)){
  46                         $nick = $msg;
  47                 }else{
  48                         die "ARGS";
  49                 }
  50
  51                 my $f = $c->model->prepare(q{
  52 WITH p AS (SELECT pid,coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank,
  53                 valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel
  54         FROM current_planet_stats
  55         WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4 LIMIT 1
  56 ), t AS (SELECT tag,bool_or(uid = $5) AS own,max(time) AS time
  57         FROM planet_tags
  58         WHERE pid = (SELECT pid FROM p)
  59                 AND ($6 OR uid = $5)
  60         GROUP BY tag
  61         ORDER BY time DESC
  62 ), tags AS (SELECT array_to_string(array_agg(tag || CASE WHEN own THEN '*' ELSE '' END),' ') AS tags
  63         FROM t
  64 )
  65 SELECT * FROM p, tags;
  66                         });
  67                 $f->execute($x,$y,$z,$nick,$c->uid,$c->check_user_roles(qw/irc_p_intel/) // 0);
  68                 if (my $planet = $f->fetchrow_hashref()){
  69                         for (keys %{$planet}){
  70                                 $planet->{$_} = $c->valuecolor(1,$planet->{$_});
  71                         }
  72                         my $ally = "";
  73                         if ($c->check_user_roles(qw/irc_p_intel/)){
  74                                 $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},";
  75                         }
  76                         $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}");
  77                 }else{
  78                         $c->reply("Couldn't find planet: $msg");
  79                 }
  80         }
  81 };
  82
  83 command g => {
  84         help => q(usage: .g X:Y),
  85 }, class extends NDIRC::Command {
  86         method execute($c,$msg) {
  87
  88                 my ($x,$y) = ($msg =~ /(\d+)\D+(\d+)/) or die 'ARGS';
  89                 my $dbh = $c->model;
  90
  91                 my $f = $dbh->prepare(q{
  92                         SELECT score,scorerank,size,sizerank,value,valuerank,planets
  93                         FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies)
  94                         });
  95                 $f->execute($x,$y);
  96                 my @row = $f->fetchrow;
  97                 unless (@row){
  98                         $c->reply("No galaxy at $x:$y");
  99                         return;
 100                 }
 101                 my @planets;
 102                 if ($c->check_user_roles(qw/irc_g_intel/)) {
 103                         my $query = $dbh->prepare(q{
 104 SELECT z,COALESCE(nick,'?') AS nick,COALESCE(alliance,'?') AS alliance
 105 FROM current_planet_stats
 106 WHERE x = $1 AND y = $2 ORDER BY z
 107                                 });
 108                         $query->execute($x,$y);
 109                         while(my $p = $query->fetchrow_hashref){
 110                                 push @planets, "$p->{z} [$p->{nick}/$p->{alliance}]";
 111                         }
 112                 }
 113                 @row = map ($c->valuecolor(1),@row);
 114                 $c->reply("$x:$y  Score=$row[0] ($row[1]), Size=$row[2] ($row[3]), Value=$row[4] ($row[5]), Planets=$row[6] - "
 115                         . join " ", @planets);
 116         }
 117 };
 118
 119 command time => {
 120         help => q(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.),
 121 }, class extends NDIRC::Command {
 122         method execute($c,$msg) {
 123         my ($tick,$timezone) = $msg =~ /^(\d+)?\s*(\S+)?$/ or die 'ARGS';
 124
 125         eval {
 126                 $tick //= $c->model->selectrow_array(q{SELECT tick()});
 127                 $timezone //= 'GMT';
 128                 my $query = $c->model->prepare(q{
 129 SELECT date_trunc('seconds',now() + (($1 - tick()) || ' hr')::interval) AT TIME ZONE $2
 130                         });
 131                 $query->execute($tick,$timezone);
 132                 my $time = $query->fetchrow_array;
 133                 $c->reply("Time at tick <b>$tick</b>, timezone <b>$timezone</b>: <b>$time</b>");
 134         };
 135         given ($@){
 136                 when(/time zone "(.+?)" not recognized/){
 137                         $c->reply("<c04>$1</c> is not a valid timezone.");
 138                 }
 139                 die $@ if $@;
 140         }
 141         }
 142 };
 143
 144 command xp => {
 145         help => q(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),
 146 }, class extends NDIRC::Command {
 147         use POSIX qw/pow/;
 148         use ND::Include;
 149         method execute($c,$msg) {
 150
 151         my ($x,$y,$z,$roids,$cap) = $msg =~ /^(\d+)\D+(\d+)\D+(\d+)(?:[^\.\d]+(\d+))?(?:[^\.\d]+(\d*\.\d+))?$/
 152                 or die 'ARGS';
 153
 154         my ($avalue,$ascore) = $c->model->selectrow_array(q{
 155 SELECT value,score FROM current_planet_stats
 156 WHERE pid = (SELECT pid FROM users WHERE uid = ?)
 157                 }, undef, $c->uid);
 158         my ($tvalue,$tscore,$tsize) = $c->model->selectrow_array(q{
 159 SELECT value,score,size FROM current_planet_stats
 160 WHERE x = ? AND y = ? and z = ?
 161                 }, undef, $x,$y,$z);
 162         $cap //= min(0.25,0.25 * pow($tvalue/$avalue , 0.5));
 163         unless($roids){
 164                 $roids = int($tsize*$cap);
 165         }elsif ($roids < 10){
 166                 $tsize = int($tsize*.75**($roids-1));
 167                 $roids = int($cap*$tsize);
 168         }
 169         $tsize -= $roids;
 170         unless (defined $avalue && defined $ascore){
 171                 $c->reply("You don't have a planet specified");
 172                 return;
 173         }
 174         unless (defined $tvalue && defined $tscore){
 175                 $c->reply("No planet found at $x:$y:$z");
 176                 return;
 177         }
 178         my $xp = pa_xp($roids,$ascore,$avalue,$tscore,$tvalue);
 179         my $score = 60 * $xp;
 180         my $value = $roids*200;
 181         my $totscore = prettyValue($score + $value);
 182         $cap = sprintf "%.1f", $cap*100;
 183         $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,");
 184         }
 185 };
 186
 187 command fco => {
 188         help => q(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 }, class extends NDIRC::Command {
 190         method execute($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
 222 my $eff = class extends NDIRC::Command {
 223         use ND::Include;
 224         method execute($c,$msg) {
 225                 my ($amount,$ship,$target) = $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) (\w+)(?: (\w+))?/
 226                         or die 'ARGS';
 227
 228                 $ship = "\%$ship\%";
 229                 $target //= '%';
 230                 my $value;
 231                 if ($self->name =~ /^v.+$/){
 232                         $value = parseValue($amount);
 233                         $value *= -1.5 if $value < 0;
 234                 }else{
 235                         $amount = parseValue($amount);
 236                 }
 237
 238                 my $feud = '';
 239
 240                 my $s= $c->model->selectrow_hashref(q{
 241 SELECT name,t1,t2,t3,"type",damage
 242         ,metal+crystal+eonium AS cost
 243         ,init,"class",guns,race,eres,armor
 244 FROM ship_stats WHERE name ILIKE ?
 245                         }, undef, $ship);
 246
 247                 return unless $s;
 248
 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)." $feud $name ($s->{init}:$value) :";
 256                 for my $tn ('t1','t2','t3'){
 257                         next unless defined ($self->target($s,$tn));
 258                         $text .= " <b><c03>" . $self->target($s,$tn) . "</c></b>: ";
 259                         my $st = $self->query(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                                 },$c,$s,$tn,$target);
 266                         while (my $t = $st->fetchrow_hashref()){
 267                                 my $number = $self->calcEff($s,$t,$tn,$amount);
 268                                 $value = prettyValue($number*$t->{cost}/100);
 269                                 my $name = shipColor($t->{name},$t->{type});
 270                                 $text .= " <b>$number</b> $name ($t->{init}:$value),";
 271                         }
 272                         chop $text;
 273                 }
 274                 $c->reply($text);
 275         }
 276
 277         method calcEff ($s,$t,$tn,$amount) {
 278                 my $number = int($self->amount($s,$t,$tn,$amount));
 279
 280                 for my $tn ('t1','t2','t3'){
 281                         my ($s1,$t1) = $self->shipOrder($s,$t);
 282                         next unless (defined $t1->{$tn});
 283                         next unless ($t1->{$tn} eq $s1->{class});
 284
 285                         if($t1->{init} <= $s1->{init}){
 286                                 $t->{init} = "<c04>$t->{init}</c>";
 287                         }else{
 288                                 $t->{init} = "<c12>$t->{init}</c>";
 289                         }
 290                 }
 291                 return $number;
 292         }
 293
 294         sub shipColor {
 295                 my ($string,$type) = @_;
 296                 my $c = 04;
 297                 $c = 12 if $type eq 'Emp';
 298                 $c = 13 if $type eq 'Steal';
 299                 return "<c$c>$string</c>";
 300         }
 301
 302         method amount ($s,$t,$tn,$amount) {
 303                 my $number = $s->{type} eq 'Emp' ?
 304                         ($amount*$s->{guns}*(100-$t->{eres})/100)
 305                         : ($amount*$s->{damage}/$t->{armor});
 306                 $number *= 0.60 if $tn eq 't2';
 307                 $number *= 0.30 if $tn eq 't3';
 308                 return $number;
 309         }
 310
 311         method target ($s,$tn) {
 312                 return $s->{$tn};
 313         }
 314
 315         method query ($st,$c,$s,$tn,$target) {
 316                 $st = $c->model->prepare($st . q{
 317                         WHERE "class" = $1
 318                         AND ("class" ILIKE $2 OR race ILIKE $2)
 319                         });
 320                 $st->execute($s->{$tn},$target);
 321                 return $st;
 322         }
 323
 324         method shipOrder ($s,$t) {
 325                 return ($s,$t);
 326         }
 327 };
 328
 329 command eff => {
 330         alias => q/veff/,
 331         help => q( syntax: .[v]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. Ter or Fi) | veff uses value instead of amount),
 332 }, $eff;
 333
 334 command stop => {
 335         alias => q/vstop/,
 336         help => q( syntax: .[v]stop 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. Ter or Fi) | vstop uses value instead of amount),
 337 }, class {
 338         extends $eff->name;
 339
 340         method target ($s,$tn){
 341                 return $tn;
 342         }
 343
 344         method query ($st,$c,$s,$tn,$target) {
 345                 $st = $c->model->prepare($st . qq{
 346                         WHERE $tn = \$1
 347                         AND ("class" ILIKE \$2 OR race ILIKE \$2)
 348                         });
 349                 $st->execute($s->{class},$target);
 350                 return $st;
 351         }
 352
 353         method amount ($s,$t,$tn,$amount) {
 354                 my $number = $t->{type} eq 'Emp' ?
 355                         ($amount*100/(100 - $s->{eres})/$t->{guns})
 356                         : ($amount*$s->{armor}/$t->{damage});
 357                 $number /= 0.60 if $tn eq 't2';
 358                 $number /= 0.30 if $tn eq 't3';
 359                 return $number;
 360         }
 361
 362         method shipOrder ($s,$t) {
 363                 return ($t,$s);
 364         }
 365 };
 366 1;