]> ruin.nu Git - NDIRC.git/blobdiff - Commands/PA.pm
Planet tags, for attaching random information to planets
[NDIRC.git] / Commands / PA.pm
index 2440feaffc747649557f4f7de524144d0cad0f6c..7fb453db9f78c513e759d679ad7db1916132a9db 100644 (file)
@@ -21,11 +21,22 @@ package NDIRC::Commands::PA;
 
 use strict;
 use warnings;
+use feature ':5.10';
 
 use Moose;
 use MooseX::MethodAttributes;
+use POSIX qw/pow/;
 
 use NDIRC::Misc;
+use ND::Include;
+
+
+sub bcalc
+       : Help(Lists bcalc and stats info)
+{
+       my ($self, $c, $msg) = @_;
+       $c->reply("http://game.planetarion.com/bcalc.pl http://game.planetarion.com/manual.php?page=stats");
+}
 
 sub p
        : Help(usage: .p X:Y:Z | or .p nick with high enough access)
@@ -44,11 +55,22 @@ sub p
        }
 
        my $f = $c->model->prepare(q{
-SELECT coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank,
-       valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel
-FROM current_planet_stats WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4 LIMIT 1
+WITH p AS (SELECT coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank,
+               valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel
+       FROM current_planet_stats
+       WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4 LIMIT 1
+), t AS (SELECT tag,bool_or(uid = $5) AS own,max(time) AS time
+       FROM planet_tags
+       WHERE pid = (SELECT pid FROM p)
+               AND ($6 OR uid = $5)
+       GROUP BY tag
+       ORDER BY time DESC
+), tags AS (SELECT array_to_string(array_agg(tag || CASE WHEN own THEN '*' ELSE '' END),' ') AS tags
+       FROM t
+)
+SELECT * FROM p, tags;
        });
-       $f->execute($x,$y,$z,$nick);
+       $f->execute($x,$y,$z,$nick,$c->uid,$c->check_user_roles(qw/irc_p_intel/));
        if (my $planet = $f->fetchrow_hashref()){
                for (keys %{$planet}){
                        $planet->{$_} = valuecolor(1,$planet->{$_});
@@ -57,7 +79,7 @@ FROM current_planet_stats WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4
                if ($c->check_user_roles(qw/irc_p_intel/)){
                        $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},";
                }
-               $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})");
+               $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}");
        }else{
                $c->reply("Couldn't find planet: $msg");
        }
@@ -81,4 +103,216 @@ FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies)
        }
 }
 
+sub time
+       : 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.)
+{
+       my ($self, $c, $msg) = @_;
+       my ($tick,$timezone) = $msg =~ /^(\d+)?\s*(\S+)?$/ or die 'ARGS';
+
+       eval {
+               $tick //= $c->model->selectrow_array(q{SELECT tick()});
+               $timezone //= 'GMT';
+               my $query = $c->model->prepare(q{
+SELECT date_trunc('seconds',now() + (($1 - tick()) || ' hr')::interval) AT TIME ZONE $2
+                       });
+               $query->execute($tick,$timezone);
+               my $time = $query->fetchrow_array;
+               $c->reply("Time at tick <b>$tick</b>, timezone <b>$timezone</b>: <b>$time</b>");
+       };
+       given ($@){
+               when(/time zone "(.+?)" not recognized/){
+                       $c->reply("<c04>$1</c> is not a valid timezone.");
+               }
+               die $@ if $@;
+       }
+}
+
+sub xp
+       : 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)
+{
+       my ($self, $c, $msg) = @_;
+
+       my ($x,$y,$z,$roids,$cap) = $msg =~ /^(\d+)\D+(\d+)\D+(\d+)(?:[^\.\d]+(\d+))?(?:[^\.\d]+(\d*\.\d+))?$/
+               or die 'ARGS';
+
+       my ($avalue,$ascore) = $c->model->selectrow_array(q{
+SELECT value,score FROM current_planet_stats
+WHERE pid = (SELECT pid FROM users WHERE uid = ?)
+               }, undef, $c->uid);
+       my ($tvalue,$tscore,$tsize) = $c->model->selectrow_array(q{
+SELECT value,score,size FROM current_planet_stats
+WHERE x = ? AND y = ? and z = ?
+               }, undef, $x,$y,$z);
+       $cap //= min(0.25,0.25 * pow($tvalue/$avalue , 0.5));
+       unless($roids){
+               $roids = int($tsize*$cap);
+       }elsif ($roids < 10){
+               $tsize = int($tsize*.75**($roids-1));
+               $roids = int($cap*$tsize);
+       }
+       $tsize -= $roids;
+       unless (defined $avalue && defined $ascore){
+               $c->reply("You don't have a planet specified");
+               return;
+       }
+       unless (defined $tvalue && defined $tscore){
+               $c->reply("No planet found at $x:$y:$z");
+               return;
+       }
+       my $xp = pa_xp($roids,$ascore,$avalue,$tscore,$tvalue);
+       my $score = 60 * $xp;
+       my $value = $roids*200;
+       my $totscore = prettyValue($score + $value);
+       $cap = sprintf "%.1f", $cap*100;
+       $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,");
+}
+
+sub fco
+       : 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)
+{
+       my ($self, $c, $msg) = @_;
+
+       my ($agents,$stolen,$tick) = $msg =~ /^(\d+)\s+(\d+)\s*(\d+)?$/ or die 'ARGS';
+
+       $tick //= $c->model->selectrow_array(q{SELECT tick()});
+
+       my ($value,$score) = $c->model->selectrow_array(q{
+SELECT value,score FROM planet_stats WHERE tick = $2 AND
+       pid = (SELECT pid FROM users WHERE uid = $1)
+               }, undef, $c->uid,$tick);
+       unless ($value){
+               $c->reply("You don't have a planet registered.");
+               return;
+       }
+       my $attackers = $c->model->prepare(q{
+SELECT coords(p.x,p.y,p.z), ruler, planet FROM current_planet_stats p
+       JOIN planet_stats ps using (pid)
+WHERE ps.tick = $1 AND trunc(2000.0*$2*$3/ps.value)::int = $4
+               });
+       $attackers->execute($tick,$agents,$value,$stolen);
+       if ($attackers->rows == 0){
+               $c->reply("No cov opper found, did you specify the right tick, and was the stolen amount not capped?");
+       }else{
+               my $coords = '';
+               while (my $attacker = $attackers->fetchrow_hashref){
+                       $coords .= " ($attacker->{coords} : $attacker->{ruler} OF $attacker->{planet})";
+               }
+               $c->reply("The planet that cov opped you is one of: $coords");
+       }
+}
+
+sub eff
+       : Alias(qw/veff stop vstop/)
+       : 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)
+{
+       my ($self, $c, $msg) = @_;
+       my ($amount,$ship,$target) = $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) (\w+)(?: (\w+))?/
+               or die 'ARGS';
+
+       my $eff = ($self->name =~ /(eff)/);
+       $ship = "\%$ship\%";
+       $target //= '%';
+       my $value;
+       if ($self->name =~ /^v.+$/){
+               $value = parseValue($amount);
+               $value *= -1.5 if $value < 0;
+       }else{
+               $amount = parseValue($amount);
+       }
+
+       my $feud = '';
+
+       my $s= $c->model->selectrow_hashref(q{
+               SELECT name,t1,t2,t3,"type",damage
+                       ,metal+crystal+eonium AS cost
+                       ,init,"class",guns,race,eres,armor
+               FROM ship_stats WHERE name ILIKE ?
+               }, undef, $ship);
+       if ($s){
+               if (defined $value){
+                       $amount = int(($value*100/$s->{cost}));
+                       $feud = '(FEUD: '.prettyValue(int($amount/0.86)).') ';
+               }
+               $value = prettyValue(($amount*$s->{cost}/100));
+               my $name = shipColor($s->{name},$s->{type});
+               my $text = prettyValue($amount)." $name ($s->{init}:$value) :";
+               for my $tn ('t1','t2','t3'){
+                       next if ($eff && not defined $s->{$tn});
+                       $text .= " <b><c03>" . ($eff ? $s->{$tn} : $tn) . "</c></b>: ";
+                       my $st = q{
+                               SELECT name,"class","type",armor
+                                       ,metal+crystal+eonium AS cost
+                                       ,init,t1,t2,t3,eres,race
+                                       ,damage,guns
+                               FROM ship_stats
+                       };
+                       if ($eff){
+                               $st = $c->model->prepare($st . q{
+                               WHERE "class" = $1
+                                       AND ("class" ILIKE $2 OR race ILIKE $2)
+                               });
+                               $st->execute($s->{$tn},$target);
+                       }else{
+                               $st = $c->model->prepare($st . qq{
+                               WHERE $tn = \$1
+                                       AND ("class" ILIKE \$2 OR race ILIKE \$2)
+                               });
+                               $st->execute($s->{class},$target);
+                       }
+                       while (my $t = $st->fetchrow_hashref()){
+                               my $number = calcEff($s,$t,$amount,$eff);
+                               if ($eff){
+                                       $number *= 0.60 if $tn eq 't2';
+                                       $number *= 0.30 if $tn eq 't3';
+                               }else{
+                                       $number /= 0.60 if $tn eq 't2';
+                                       $number /= 0.30 if $tn eq 't3';
+                               }
+                               $number = int($number);
+                               $value = prettyValue($number*$t->{cost}/100);
+                               my $name = shipColor($t->{name},$t->{type});
+                               $text .= " <b>$number</b> $name ($t->{init}:$value),";
+                       }
+                       chop $text;
+               }
+               $c->reply($text);
+       }
+}
+
+sub calcEff {
+       my ($s,$t,$amount,$eff) = @_;
+
+       my $number = 0;
+       if ($eff){
+               $number = $s->{type} eq 'Emp' ?
+                       ($amount*$s->{guns}*(100-$t->{eres})/100)
+                       : ($amount*$s->{damage}/$t->{armor});
+       }else{
+               $number = $t->{type} eq 'Emp' ?
+                       ($amount*100/(100 - $s->{eres})/$t->{guns})
+                       : ($amount*$s->{armor}/$t->{damage});
+       }
+
+       for my $tn ('t1','t2','t3'){
+               my ($s1,$t1) = $eff ? ($s,$t) : ($t,$s);
+               next unless (defined $t1->{$tn});
+               next unless ($t1->{$tn} eq $s1->{class});
+
+               if($t1->{init} <= $s1->{init}){
+                       $t->{init} = "<c04>$t->{init}</c>";
+               }else{
+                       $t->{init} = "<c12>$t->{init}</c>";
+               }
+       }
+       return $number;
+}
+
+sub shipColor {
+       my ($string,$type) = @_;
+       my $c = 04;
+       $c = 12 if $type eq 'Emp';
+       $c = 13 if $type eq 'Steal';
+       return "<c$c>$string</c>";
+}
+
 1;