PA.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2006 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 package NDIRC::PA;
  20 use strict;
  21 use warnings;
  22 use ND::DB;
  23 use ND::Include;
  24 use NDIRC::Access;
  25 use NDIRC::Misc;
  26 use POSIX;
  27 require Exporter;
  28
  29 our @ISA = qw/Exporter/;
  30
  31 our @EXPORT = qw/shipEff shipStop parseValue prettyValue findCovOpper/;
  32
  33 sub shipEff {
  34         my ($msg,$command) = @_;
  35         my ($amount,$ship,$value,$target);
  36         my $eff = 1;
  37         $eff = 0 if $command =~ /stop/;
  38         if(defined $msg && $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) (\w+)(?: (\w+))?/){
  39                 $ship = "\%$2\%";
  40                 $target = ($3 || '%');
  41                 my $am = $1;
  42                 if ($command =~ /^v.+$/){
  43                         $value = parseValue($am);
  44                         $value *= -1.5 if $value < 0;
  45                         my $feud = '';
  46                 }else{
  47                         $amount = parseValue($am);
  48                 }
  49         }else{
  50                 $ND::server->command("notice $ND::nick syntax: $command 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)");
  51                 return;
  52         }
  53         my $feud = '';
  54
  55         my $s= $ND::DBH->selectrow_hashref(q{
  56                 SELECT name,t1,t2,t3,"type",damage
  57                         ,metal+crystal+eonium AS cost
  58                         ,init,"class",guns,race,eres,armor
  59                 FROM ship_stats WHERE name ILIKE ?
  60                 }, undef, $ship);
  61         if ($s){
  62                 if (defined $value){
  63                         $amount = int(($value*100/$s->{cost}));
  64                         $feud = '(FEUD: '.prettyValue(int($amount/0.86)).') ';
  65                 }
  66                 $value = prettyValue(($amount*$s->{cost}/100));
  67                 my $name = shipColor($s->{name},$s->{type});
  68                 my $text = prettyValue($amount)." $name ($s->{init}:$value) :";
  69                 for my $tn ('t1','t2','t3'){
  70                         next if ($eff && not defined $s->{$tn});
  71                         $text .= " $ND::B${ND::C}03" . ($eff ? $s->{$tn} : $tn) . "$ND::O: ";
  72                         my $st = q{
  73                                 SELECT name,"class","type",armor
  74                                         ,metal+crystal+eonium AS cost
  75                                         ,init,t1,t2,t3,eres,race
  76                                         ,damage,guns
  77                                 FROM ship_stats
  78                                 };
  79                         if ($eff){
  80                                 $st = $ND::DBH->prepare($st . q{
  81                                 WHERE "class" = $1
  82                                         AND ("class" ILIKE $2 OR race ILIKE $2)
  83                                 });
  84                                 $st->execute($s->{$tn},$target);
  85                         }else{
  86                                 $st = $ND::DBH->prepare($st . qq{
  87                                 WHERE $tn = \$1
  88                                         AND ("class" ILIKE \$2 OR race ILIKE \$2)
  89                                 });
  90                                 $st->execute($s->{class},$target);
  91                         }
  92                         while (my $t = $st->fetchrow_hashref()){
  93                                 my $number = calcEff($s,$t,$amount,$eff);
  94                                 if ($eff){
  95                                         $number *= 0.60 if $tn eq 't2';
  96                                         $number *= 0.30 if $tn eq 't3';
  97                                 }else{
  98                                         $number /= 0.60 if $tn eq 't2';
  99                                         $number /= 0.30 if $tn eq 't3';
 100                                 }
 101                                 $number = int($number);
 102                                 $value = prettyValue($number*$t->{cost}/100);
 103                                 my $name = shipColor($t->{name},$t->{type});
 104                                 $text .= " $ND::B$number$ND::O $name ($t->{init}:$value),";
 105                         }
 106                         chop $text;
 107                 }
 108                 $ND::server->command("notice $ND::nick $text");
 109         }
 110 }
 111
 112 sub calcEff {
 113         my ($s,$t,$amount,$eff) = @_;
 114
 115         my $number = 0;
 116         if ($eff){
 117                 $number = $s->{type} eq 'Emp' ?
 118                         ($amount*$s->{guns}*(100-$t->{eres})/100)
 119                         : ($amount*$s->{damage}/$t->{armor});
 120         }else{
 121                 $number = $t->{type} eq 'Emp' ?
 122                         ($amount*100/(100 - $s->{eres})/$t->{guns})
 123                         : ($amount*$s->{armor}/$t->{damage});
 124         }
 125
 126         for my $tn ('t1','t2','t3'){
 127                 my ($s1,$t1) = $eff ? ($s,$t) : ($t,$s);
 128                 next unless (defined $t1->{$tn});
 129                 next unless ($t1->{$tn} eq $s1->{class});
 130
 131                 if($t1->{init} <= $s1->{init}){
 132                         $t->{init} = "${ND::C}04$t->{init}$ND::O";
 133                 }else{
 134                         $t->{init} = "${ND::C}12$t->{init}$ND::O";
 135                 }
 136         }
 137         return $number;
 138 }
 139
 140 sub shipColor {
 141         my ($string,$type) = @_;
 142         my $c = 04;
 143         $c = 12 if $type eq 'Emp';
 144         $c = 13 if $type eq 'Steal';
 145         return "$ND::C$c$string$ND::O";
 146 }
 147
 148 1;