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         type => 'member',
  38 }, class extends NDIRC::Command {
  39         method execute($c,$msg) {
  40
  41                 my ($x,$y,$z,$nick);
  42                 if ($msg =~ /(\d+)\D+(\d+)\D+(\d+)/){
  43                         $x = $1;
  44                         $y = $2;
  45                         $z = $3;
  46                 }elsif ($msg && $c->check_user_roles(qw/irc_p_nick/)){
  47                         $nick = $msg;
  48                 }else{
  49                         die "ARGS";
  50                 }
  51
  52                 my $f = $c->model->prepare(q{
  53 WITH p AS (SELECT pid,coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank,
  54                 valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel
  55         FROM current_planet_stats
  56         WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4 LIMIT 1
  57 ), t AS (SELECT tag,bool_or(uid = $5) AS own,max(time) AS time
  58         FROM planet_tags
  59         WHERE pid = (SELECT pid FROM p)
  60                 AND ($6 OR uid = $5)
  61         GROUP BY tag
  62         ORDER BY time DESC
  63 ), tags AS (SELECT array_to_string(array_agg(tag || CASE WHEN own THEN '*' ELSE '' END),' ') AS tags
  64         FROM t
  65 )
  66 SELECT * FROM p, tags;
  67                         });
  68                 $f->execute($x,$y,$z,$nick,$c->uid,$c->check_user_roles(qw/irc_p_intel/) // 0);
  69                 if (my $planet = $f->fetchrow_hashref()){
  70                         for (keys %{$planet}){
  71                                 $planet->{$_} = $c->valuecolor(1,$planet->{$_});
  72                         }
  73                         my $ally = "";
  74                         if ($c->check_user_roles(qw/irc_p_intel/)){
  75                                 $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},";
  76                         }
  77                         $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}");
  78                 }else{
  79                         $c->reply("Couldn't find planet: $msg");
  80                 }
  81         }
  82 };
  83
  84 command g => {
  85         help => q(usage: .g X:Y),
  86 }, class extends NDIRC::Command {
  87         method execute($c,$msg) {
  88
  89                 my ($x,$y) = ($msg =~ /(\d+)\D+(\d+)/) or die 'ARGS';
  90                 my $dbh = $c->model;
  91
  92                 my $f = $dbh->prepare(q{
  93                         SELECT score,scorerank,size,sizerank,value,valuerank,planets
  94                         FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies)
  95                         });
  96                 $f->execute($x,$y);
  97                 my @row = $f->fetchrow;
  98                 unless (@row){
  99                         $c->reply("No galaxy at $x:$y");
 100                         return;
 101                 }
 102                 my @planets;
 103                 if ($c->check_user_roles(qw/irc_g_intel/)) {
 104                         my $query = $dbh->prepare(q{
 105 SELECT z,COALESCE(nick,'?') AS nick,COALESCE(alliance,'?') AS alliance
 106 FROM current_planet_stats
 107 WHERE x = $1 AND y = $2 ORDER BY z
 108                                 });
 109                         $query->execute($x,$y);
 110                         while(my $p = $query->fetchrow_hashref){
 111                                 push @planets, "$p->{z} [$p->{nick}/$p->{alliance}]";
 112                         }
 113                 }
 114                 @row = map ($c->valuecolor(1),@row);
 115                 $c->reply("$x:$y  Score=$row[0] ($row[1]), Size=$row[2] ($row[3]), Value=$row[4] ($row[5]), Planets=$row[6] - "
 116                         . join " ", @planets);
 117         }
 118 };
 119
 120 command time => {
 121         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.),
 122 }, class extends NDIRC::Command {
 123         method execute($c,$msg) {
 124         my ($tick,$timezone) = $msg =~ /^(\d+)?\s*(\S+)?$/ or die 'ARGS';
 125
 126         eval {
 127                 $tick //= $c->model->selectrow_array(q{SELECT tick()});
 128                 $timezone //= 'GMT';
 129                 my $query = $c->model->prepare(q{
 130 SELECT date_trunc('seconds',now() + (($1 - tick()) || ' hr')::interval) AT TIME ZONE $2
 131                         });
 132                 $query->execute($tick,$timezone);
 133                 my $time = $query->fetchrow_array;
 134                 $c->reply("Time at tick <b>$tick</b>, timezone <b>$timezone</b>: <b>$time</b>");
 135         };
 136         given ($@){
 137                 when(/time zone "(.+?)" not recognized/){
 138                         $c->reply("<c04>$1</c> is not a valid timezone.");
 139                 }
 140                 die $@ if $@;
 141         }
 142         }
 143 };
 144
 145 command xp => {
 146         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),
 147 }, class extends NDIRC::Command {
 148         use POSIX qw/pow/;
 149         use ND::Include;
 150         method execute($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
 188 command fco => {
 189         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),
 190 }, class extends NDIRC::Command {
 191         method execute($c,$msg) {
 192
 193         my ($agents,$stolen,$tick) = $msg =~ /^(\d+)\s+(\d+)\s*(\d+)?$/ or die 'ARGS';
 194
 195         $tick //= $c->model->selectrow_array(q{SELECT tick()});
 196
 197         my ($value,$score) = $c->model->selectrow_array(q{
 198 SELECT value,score FROM planet_stats WHERE tick = $2 AND
 199         pid = (SELECT pid FROM users WHERE uid = $1)
 200                 }, undef, $c->uid,$tick);
 201         unless ($value){
 202                 $c->reply("You don't have a planet registered.");
 203                 return;
 204         }
 205         my $attackers = $c->model->prepare(q{
 206 SELECT coords(p.x,p.y,p.z), ruler, planet FROM current_planet_stats p
 207         JOIN planet_stats ps using (pid)
 208 WHERE ps.tick = $1 AND trunc(2000.0*$2*$3/ps.value)::int = $4
 209                 });
 210         $attackers->execute($tick,$agents,$value,$stolen);
 211         if ($attackers->rows == 0){
 212                 $c->reply("No cov opper found, did you specify the right tick, and was the stolen amount not capped?");
 213         }else{
 214                 my $coords = '';
 215                 while (my $attacker = $attackers->fetchrow_hashref){
 216                         $coords .= " ($attacker->{coords} : $attacker->{ruler} OF $attacker->{planet})";
 217                 }
 218                 $c->reply("The planet that cov opped you is one of: $coords");
 219         }
 220         }
 221 };
 222
 223 my $eff = class extends NDIRC::Command {
 224         use ND::Include;
 225         method execute($c,$msg) {
 226                 my ($amount,$ship,$target) = $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) ([\w\%]+)(?: (\w+))?/
 227                         or die 'ARGS';
 228
 229                 $ship = "$ship\%";
 230                 $target //= '%';
 231                 my $value;
 232                 if ($self->name =~ /^v.+$/){
 233                         $value = parseValue($amount);
 234                         $value *= -1.5 if $value < 0;
 235                 }else{
 236                         $amount = parseValue($amount);
 237                 }
 238
 239                 my $feud = '';
 240
 241                 my $s= $c->model->selectrow_hashref(q{
 242 SELECT ship,t1,t2,t3,"type",damage
 243         ,metal+crystal+eonium AS cost
 244         ,init,"class",guns,race,eres,armor
 245 FROM ship_stats WHERE ship ILIKE ?
 246                         }, undef, $ship);
 247
 248                 return unless $s;
 249
 250                 if (defined $value){
 251                         $amount = int(($value*100/$s->{cost}));
 252                         $feud = '(Dem/Tot: '.prettyValue(int($amount/0.92)).') ';
 253                 }
 254                 $value = prettyValue(($amount*$s->{cost}/100));
 255                 my $name = shipColor($s->{ship},$s->{type});
 256                 my $text = prettyValue($amount)." $feud $name ($s->{init}:$value) :";
 257                 for my $tn ('t1','t2','t3'){
 258                         next unless defined ($self->target($s,$tn));
 259                         $text .= " <b><c03>" . $self->target($s,$tn) . "</c></b>: ";
 260                         my $st = $self->query(q{
 261 SELECT ship,"class","type",armor
 262         ,metal+crystal+eonium AS cost
 263         ,init,t1,t2,t3,eres,race
 264         ,damage,guns
 265 FROM ship_stats
 266                                 },$c,$s,$tn,$target);
 267                         while (my $t = $st->fetchrow_hashref()){
 268                                 my $number = $self->calcEff($s,$t,$tn,$amount);
 269                                 $value = prettyValue($number*$t->{cost}/100);
 270                                 my $name = shipColor($t->{ship},$t->{type});
 271                                 $text .= " <b>$number</b> $name ($t->{init}:$value),";
 272                         }
 273                         chop $text;
 274                 }
 275                 $c->reply($text);
 276         }
 277
 278         method calcEff ($s,$t,$tn,$amount) {
 279                 my $number = int($self->amount($s,$t,$tn,$amount));
 280
 281                 for my $tn ('t1','t2','t3'){
 282                         my ($s1,$t1) = $self->shipOrder($s,$t);
 283                         next unless (defined $t1->{$tn});
 284                         next unless ($t1->{$tn} eq $s1->{class});
 285
 286                         if($t1->{init} <= $s1->{init}){
 287                                 $t->{init} = "<c04>$t->{init}</c>";
 288                         }else{
 289                                 $t->{init} = "<c12>$t->{init}</c>";
 290                         }
 291                 }
 292                 return $number;
 293         }
 294
 295         sub shipColor {
 296                 my ($string,$type) = @_;
 297                 my $c = 04;
 298                 $c = 12 if $type eq 'Emp';
 299                 $c = 13 if $type eq 'Steal';
 300                 return "<c$c>$string</c>";
 301         }
 302
 303         method amount ($s,$t,$tn,$amount) {
 304                 my $number = $s->{type} eq 'Emp' ?
 305                         ($amount*$s->{guns}*(100-$t->{eres})/100)
 306                         : ($amount*$s->{damage}/$t->{armor});
 307                 $number *= 0.60 if $tn eq 't2';
 308                 $number *= 0.30 if $tn eq 't3';
 309                 return $number;
 310         }
 311
 312         method target ($s,$tn) {
 313                 return $s->{$tn};
 314         }
 315
 316         method query ($st,$c,$s,$tn,$target) {
 317                 $st = $c->model->prepare($st . q{
 318                         WHERE "class" = $1
 319                         AND ("class" ILIKE $2 OR race ILIKE $2)
 320                         });
 321                 $st->execute($s->{$tn},$target);
 322                 return $st;
 323         }
 324
 325         method shipOrder ($s,$t) {
 326                 return ($s,$t);
 327         }
 328 };
 329
 330 command eff => {
 331         alias => q/veff/,
 332         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),
 333 }, $eff;
 334
 335 command stop => {
 336         alias => q/vstop/,
 337         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),
 338 }, class {
 339         extends $eff->name;
 340
 341         method target ($s,$tn){
 342                 return $tn;
 343         }
 344
 345         method query ($st,$c,$s,$tn,$target) {
 346                 $st = $c->model->prepare($st . qq{
 347                         WHERE $tn = \$1
 348                         AND ("class" ILIKE \$2 OR race ILIKE \$2)
 349                         });
 350                 $st->execute($s->{class},$target);
 351                 return $st;
 352         }
 353
 354         method amount ($s,$t,$tn,$amount) {
 355                 my $number = $t->{type} eq 'Emp' ?
 356                         ($amount*100/(100 - $s->{eres})/$t->{guns})
 357                         : ($amount*$s->{armor}/$t->{damage});
 358                 $number /= 0.60 if $tn eq 't2';
 359                 $number /= 0.30 if $tn eq 't3';
 360                 return $number;
 361         }
 362
 363         method shipOrder ($s,$t) {
 364                 return ($t,$s);
 365         }
 366 };
 367 1;