From 521551cfe4104e3a464175fd063054bf38038b2c Mon Sep 17 00:00:00 2001
From: ElTata <eltata@firemail.cc>
Date: Mon, 28 Oct 2019 11:45:49 +0100
Subject: [PATCH] actions delay fixed
- before, you had to wait one hour for one action to be available, even
if you use them simultaneously, now there is one countdown per action
- new function in Utils exec_delayed, to execute function after a given
time
- actions delays are stored in a new file named in the config file
- the main loop of Main (rpcheck subroutine) now checks for delayed
functions to execute
- other typo/style fixs
---
.irpg.conf | 5 ++
Irpg/Action.pm | 56 +++++++++++++-------
Irpg/Main.pm | 136 ++++++++++++++++++++++++++-----------------------
Irpg/Utils.pm | 64 +++++++++++++++++++----
4 files changed, 171 insertions(+), 90 deletions(-)
diff --git a/.irpg.conf b/.irpg.conf
index 76d5f50..ea9289a 100644
--- a/.irpg.conf
+++ b/.irpg.conf
@@ -84,6 +84,11 @@ rppenstep 1.14
# player database file
dbfile irpg.db
+# actions database file
+# the file where the delays before the next actions of players
+# are stored
+actionsfile next_actions.db
+
# where quests/godsends/calamities are stored
eventsfile events.txt
diff --git a/Irpg/Action.pm b/Irpg/Action.pm
index bf5f0d5..55993f0 100644
--- a/Irpg/Action.pm
+++ b/Irpg/Action.pm
@@ -7,7 +7,7 @@ use Irpg::Irc qw(:interaction);
use Exporter qw(import);
our @EXPORT = qw(&choose_action &itemsum
&challenge_opp &collision_action &team_battle);
-our @EXPORT_OK = qw(itemsum);
+our @EXPORT_OK = qw(itemsum new_action);
my $primnick_ref;
my $opts;
@@ -19,7 +19,13 @@ my $rps;
=item SCALAR (ref) - reference to the options hash
=item SCALAR (ref) - reference to the players hash
=cut
-sub init_pkg { ($opts, $rps, $primnick_ref) = @_; }
+sub init_pkg {
+ ($opts, $rps, $primnick_ref) = @_;
+ foreach my $user (keys %$rps) {
+ map { Irpg::Utils::execute_delayed($_, \&new_action, $user) }
+ @{$rps->{$user}{next_a}};
+ }
+}
sub fisher_yates_shuffle {
@@ -130,7 +136,7 @@ sub mystic_result {
push(@queue,
"$p1 has cast a Critical Spell! ".
duration($gain)." of ".pronoun(2, $rps->{$p1}{gender}).
- " clock is sent to another plan. ".
+ " clock is sent to another plane. ".
"$p1 reaches next level in ".duration($rps->{$p1}{next}).".");
}
}
@@ -194,9 +200,9 @@ sub steal_result {
my $tempitem = $rps->{$p1}{item}{$type};
$rps->{$p1}{item}{$type}=$rps->{$p2}{item}{$type};
$rps->{$p2}{item}{$type} = $tempitem;
- $queue[$#queue] .= pronoun(1, $rps->{$p1}{gender})." has retrieved ".
+ $queue[$#queue] .= ucfirst(pronoun(1, $rps->{$p1}{gender}))." has retrieved ".
"the finest of $p2\'s equipment. $p1 then proceeds to crawl ".
- "back into the shadows ".pronoun(1, $rps->{$p1}{gender})." came".
+ "back into the shadows ".pronoun(1, $rps->{$p1}{gender})." came ".
"from, ".pronoun(2, $rps->{$p1}{gender})." nefarious deed ".
"unknown from any soul but ".pronoun(3, $rps->{$p1}{gender}).
"self.";
@@ -244,7 +250,7 @@ sub perform_action {
if ($p1roll < 5 || $p2roll < 5 || $p1sum < 5 || $p2roll < 5) {
$ret = {p1sum=>$p1sum, p2sum=>$p2sum,
p1roll=>$p1roll, p2roll=>$p2roll,
- p1atk=>$p1atk, p2def=>$p2def,
+ p1atk=>$p1atk, p2def=>$p2def,
vict=>0};
}
else {
@@ -259,7 +265,7 @@ sub perform_action {
my $align_mod = $rps->{$p1}{alignment} eq 'Good' ? 0.05 :
$rps->{$p1}{alignment} eq 'Evil' ? -0.10 :
1;
- if ($p1roll >= $p1sum * $p1atk * ($rps->{$p1}{class}->{CRIT_SK} + $align_mod)) {
+ if ($p1roll*$p1atk >= $p1sum*$p1atk*($rps->{$p1}{class}->{CRIT_SK} + $align_mod)) {
# CRITICAL STRIKE
$ret->{vict}++;
}
@@ -276,8 +282,8 @@ sub challenge_opp { # pit argument player against random player
my $action_type = choose_action($p1);
my $ret_action = perform_action($p1, $p2, $action_type);
my $res_action = eval $action_type.'_result($p1, $p2, $ret_action->{vict})';
- my $p1_res = "[$ret_action->{p1roll}*$ret_action->{p1atk}/$ret_action->{p1sum}]";
- my $p2_res = "[$ret_action->{p2roll}*$ret_action->{p2def}/$ret_action->{p2sum}]";
+ my $p1_res = "[$ret_action->{p1roll}/$ret_action->{p1sum}]*$ret_action->{p1atk}";
+ my $p2_res = "[$ret_action->{p2roll}/$ret_action->{p2sum}]*$ret_action->{p2def}";
my $mesg = '';
if ($action_type eq 'fight') {
@@ -304,8 +310,8 @@ sub collision_action {
my $ret_action = perform_action($p1, $p2, $action_type);
my $res_action = eval $action_type.'_result($p1, $p2, $ret_action->{vict})';
- my $p1_res = "[$ret_action->{p1roll}*$ret_action->{p1atk}/$ret_action->{p1sum}]";
- my $p2_res = "[$ret_action->{p2roll}*$ret_action->{p2def}/$ret_action->{p2sum}]";
+ my $p1_res = "[$ret_action->{p1roll}/$ret_action->{p1sum}]*$ret_action->{p1atk}";
+ my $p2_res = "[$ret_action->{p2roll}/$ret_action->{p2sum}]*$ret_action->{p2def}";
my $mesg = "$p1 $p1_res has come upon $p2 $p2_res and ";
if ($action_type eq 'fight') {
$mesg .= ($ret_action->{vict} ?
@@ -353,12 +359,12 @@ sub team_battle { # pit three players against three other players
$sum = int(itemsum($opp[$i],1));
if ($i < 3) {
$mysum += $sum;
- $mod = eval '$rps->{$p1}{class}->'.$action_type.'_atk()';
+ $mod = eval '$rps->{$opp[$i]}{class}->'.$action_type.'_atk()';
$myroll += int(rand($sum) * $mod);
}
else {
$oppsum += $sum;
- $mod = eval '$rps->{$p1}{class}->'.$action_type.'_def()';
+ $mod = eval '$rps->{$opp[$i]}{class}->'.$action_type.'_def()';
$opproll += int(rand($sum) * $mod);
}
}
@@ -446,20 +452,20 @@ sub do_action {
elsif (exists($arg[0])) {
$p2 = $arg[0];
# choosing your adversary cost an extra action point
- $rps->{$username}{actions}--;
+ consume_action($username);
}
else {
$p2 = $opps[int(rand(@opps))];
}
- $rps->{$username}{actions}--;
+ consume_action($username);
$rps->{$username}{next_a} = 3600 unless ($rps->{$username}{next_a});
my $p1 = $username;
my $action_type = choose_action($p1);
my $ret_action = perform_action($p1, $p2, $action_type);
my $res_action = eval $action_type.'_result($p1, $p2, $ret_action->{vict}, 1)';
- my $p1_res = "[$ret_action->{p1roll}*$ret_action->{p1atk}/$ret_action->{p1sum}]";
- my $p2_res = "[$ret_action->{p2roll}*$ret_action->{p2def}/$ret_action->{p2sum}]";
+ my $p1_res = "[$ret_action->{p1roll}/$ret_action->{p1sum}]*$ret_action->{p1atk}";
+ my $p2_res = "[$ret_action->{p2roll}/$ret_action->{p2sum}]*$ret_action->{p2def}";
my $mesg = '';
if ($action_type eq 'fight') {
@@ -483,6 +489,22 @@ sub do_action {
foreach (@$res_action) { Irpg::Irc::chanmsg(Irpg::Utils::clog($_)); }
}
+sub consume_action {
+ my $player = shift;
+ return unless (exists($rps->{$player}));
+ $rps->{$player}{actions}--;
+ push $rps->{$player}{next_a}, 3600;
+ Irpg::Utils::execute_delayed(3600, \&new_action, $player);
+}
+
+sub new_action {
+ my $player = shift;
+ return unless (exists($rps->{$player}));
+ $rps->{$player}{actions}++;
+ Irpg::Irc::notice("You feel ready to perform a new deed !",
+ $rps->{$player}{nick});
+}
+
our $commands = {
action => {ref => \&do_action, adm => 0, prv => 1, pub => 1,
hlp => 'ACTION [<char name>]: perform an action (fight/mystic/steal) '.
diff --git a/Irpg/Main.pm b/Irpg/Main.pm
index c91c535..bc679cf 100644
--- a/Irpg/Main.pm
+++ b/Irpg/Main.pm
@@ -38,6 +38,7 @@ my $primnick;
my $opts;
my $rps;
my $prev_online;
+my $delayed_funcs;
=head1 FUNCTION init_pkg
This function sets the references to
options and players hashes.
@@ -45,9 +46,10 @@ my $prev_online;
=item SCALAR (ref) - reference to the options hash
=item SCALAR (ref) - reference to the players hash
=item SCALAR (ref) - reference to the prev_online hash
+=item SCALAR (ref) - reference to the delayed_funcs array
=cut
sub init_pkg {
- ($opts, $rps, $lasttime_ref, $prev_online) = @_;
+ ($opts, $rps, $lasttime_ref, $prev_online, $delayed_funcs) = @_;
$primnick = $opts->{botnick}; # for regain or register checks
Irpg::Irc::init_pkg(\$silentmode);
Irpg::Quest::init_pkg($opts, $rps);
@@ -251,7 +253,6 @@ sub rpcheck { # check levels, update database
# check splits hash to see if any split users have expired
checksplits() if $opts->{detectsplits};
# send out $freemessages lines of text from the outgoing message queue
- #fq();
Irpg::Irc::fq();
# clear registration limiting
$lastreg = 0;
@@ -262,11 +263,11 @@ sub rpcheck { # check levels, update database
### MOVING PLAYERS ###
moveplayers();
- ### ALL MODULES CHEKS ###
+ ### ALL MODULES CHECKS ###
# statements using $rpreport do not bother with scaling by the clock because
# $rpreport is adjusted by the number of seconds since last rpcheck()
foreach (qw(Quest Action Event)) {
- eval 'Irpg::'.$_.'::rpcheck($rpreport, $online';
+ eval 'Irpg::'.$_.'::rpcheck($rpreport, $online)';
}
### TOP PLAYERS REPORT ###
@@ -298,67 +299,75 @@ sub rpcheck { # check levels, update database
Irpg::Irc::chanmsg("WARNING: Cannot write database in PAUSE mode!");
}
- ### UPDATE PLAYERS DATA ###
+ ### TIME RELATED STUFFS ###
# (time related data, and here is the levelling)
- #
- # do not write in pause mode, and do not write if not yet connected. (would
- # log everyone out if the bot failed to connect. $lasttime = time() on
- # successful join to $opts->{botchan}, initial value is 1). if fails to open
- # $opts->{dbfile}, will not update $lasttime and so should have correct values
- # on next rpcheck().
- if ($$lasttime_ref != 1) {
- my $curtime=time();
- for my $k (keys(%$rps)) {
- if ($rps->{$k}{online} && exists $rps->{$k}{nick} &&
- $rps->{$k}{nick} && exists $onchan{$rps->{$k}{nick}}) {
- $rps->{$k}{next} -= ($curtime - $$lasttime_ref);
- $rps->{$k}{next_a} = map { $_ - ($curtime - $$lasttime_ref) }
- $rps->{$k}{next_a};
- #$rps->{$k}{next_a} -= ($curtime - $$lasttime_ref);
- #$rps->{$k}{next_a} = 0 if ($rps->{$k}{next_a} < 0);
- $rps->{$k}{idled} += ($curtime - $$lasttime_ref);
- if ($rps->{$k}{next} < 1) {
- $rps->{$k}{level}++;
- if (!($rps->{$k}{level} % 5)){
- $rps->{$k}{points}++;
- Irpg::Irc::notice(
- "Your hard training paid off, and you have ".
- "one more point to invest.",
- $rps->{$k}{nick});
- }
- if ($rps->{$k}{level} > 60) {
- $rps->{$k}{next} = int(($opts->{rpbase} *
- ($opts->{rpstep}**60)) +
- (86400*($rps->{$k}{level} - 60)));
- }
- else {
- $rps->{$k}{next} = int($opts->{rpbase} *
- ($opts->{rpstep}**$rps->{$k}{level}));
- }
- Irpg::Irc::chanmsg("$k, the $rps->{$k}{alignment} ".
- "$rps->{$k}{title} $rps->{$k}{class}->{NAME}, ".
- "has attained level $rps->{$k}{level}! ".
- "Next level in ".duration($rps->{$k}{next}).".");
- find_item($k);
- challenge_opp($k);
+
+ # $lasttime = time() on successful join to $opts->{botchan}, initial value is 1).
+ # do nothing if not connected
+ next if ($$lasttime_ref == 1);
+ my $curtime=time();
+
+ ## Delayed Funcs ##
+ Irpg::Utils::exec_stack_delayed($curtime);
+
+ ## Update Players Data ##
+ for my $k (keys(%$rps)) {
+ if ($rps->{$k}{online} && exists $rps->{$k}{nick} &&
+ $rps->{$k}{nick} && exists $onchan{$rps->{$k}{nick}}) {
+ $rps->{$k}{next} -= ($curtime - $$lasttime_ref);
+ @{$rps->{$k}{next_a}} = grep { $_ > 0 }
+ map { $_ - ($curtime - $$lasttime_ref) }
+ @{$rps->{$k}{next_a}};
+ #$rps->{$k}{next_a} -= ($curtime - $$lasttime_ref);
+ #$rps->{$k}{next_a} = 0 if ($rps->{$k}{next_a} < 0);
+ $rps->{$k}{idled} += ($curtime - $$lasttime_ref);
+ if ($rps->{$k}{next} < 1) {
+ $rps->{$k}{level}++;
+ if (!($rps->{$k}{level} % 5)){
+ $rps->{$k}{points}++;
+ Irpg::Irc::notice(
+ "Your hard training paid off, and you have ".
+ "one more point to invest.",
+ $rps->{$k}{nick});
+ }
+ if ($rps->{$k}{level} > 60) {
+ $rps->{$k}{next} = int(($opts->{rpbase} *
+ ($opts->{rpstep}**60)) +
+ (86400*($rps->{$k}{level} - 60)));
}
- if ($rps->{$k}{next_a} < 1
- && $rps->{$k}{actions} < int($rps->{$k}{level}/10)) {
- $rps->{$k}{actions}++;
- if ($rps->{$k}{actions} < int($rps->{$k}{level}/10)) {
- $rps->{$k}{next_a} = 3600
- }
- Irpg::Irc::notice("You feel ready to perform a new deed !",
- $rps->{$k}{nick});
+ else {
+ $rps->{$k}{next} = int($opts->{rpbase} *
+ ($opts->{rpstep}**$rps->{$k}{level}));
}
+ Irpg::Irc::chanmsg("$k, the $rps->{$k}{alignment} ".
+ "$rps->{$k}{title} $rps->{$k}{class}->{NAME}, ".
+ "has attained level $rps->{$k}{level}! ".
+ "Next level in ".duration($rps->{$k}{next}).".");
+ find_item($k);
+ challenge_opp($k);
+ }
+ #if ($rps->{$k}{next_a} < 1
+ # && $rps->{$k}{actions} < int($rps->{$k}{level}/10)) {
+ # $rps->{$k}{actions}++;
+ # if ($rps->{$k}{actions} < int($rps->{$k}{level}/10)) {
+ # $rps->{$k}{next_a} = 3600
+ # }
+ # Irpg::Irc::notice("You feel ready to perform a new deed !",
+ # $rps->{$k}{nick});
+ #}
+ if ($rps->{$k}{actions} + @{$rps->{$k}{next_a}} < int($rps->{$k}{level}/10)) {
+ Irpg::Action::new_action($k);
}
- # attempt to make sure this is an actual user, and not just an
- # artifact of a bad PEVAL
}
- if (!$pausemode && $rpreport%60==0) { writedb($rps); }
- $rpreport += $opts->{self_clock};
- $$lasttime_ref = $curtime;
- }
+ # attempt to make sure this is an actual user, and not just an
+ # artifact of a bad PEVAL
+ }
+ # do not write in pause mode (would log everyone out if the bot failed to connect)
+ # if fails to open $opts->{dbfile}, will not update $lasttime and
+ # so should have correct values on next rpcheck().
+ if (!$pausemode && $rpreport%60==0) { writedb($rps); }
+ $rpreport += $opts->{self_clock};
+ $$lasttime_ref = $curtime;
}
@@ -394,8 +403,9 @@ sub parse {
Irpg::Irc::sts("NICK $opts->{botnick}");
}
elsif ($arg[1] eq 'join') {
+ return if (! $opts->{botchan} eq substr($arg[2], 1));
# %onchan holds time user joined channel. used just to now who is there
- $onchan{$usernick}=time() if ($opts->{botchan} eq substr($arg[2], 1));
+ $onchan{$usernick}=time();
if (grep { $rps->{$_}{nick} eq $usernick } keys %$rps) {
Irpg::Irc::sts("WHOIS $usernick");
@@ -404,7 +414,7 @@ sub parse {
if ($opts->{'detectsplits'} && exists($split{substr($arg[0],1)})) {
delete($split{substr($arg[0],1)});
}
- elsif ($opts->{botnick} eq $usernick && $opts->{botchan} eq substr($arg[2], 1)) {
+ elsif ($opts->{botnick} eq $usernick) {
Irpg::Irc::sts("WHO $opts->{botchan}");
(my $opcmd = $opts->{botopcmd}) =~ s/%botnick%/$opts->{botnick}/eg;
Irpg::Irc::sts($opcmd);
@@ -560,7 +570,7 @@ sub parse {
$source = $arg[2];
}
if ((!$token_need || $token_given) &&
- grep /\Q$arg[3]\E/,
+ grep { $arg[3] eq $_ }
grep({ $commands{$_}->{$msgtype} } keys(%commands))) {
# the message is a command valid in $msgtype message
if (!$commands{$arg[3]}->{adm} || ha($usernick)) {
diff --git a/Irpg/Utils.pm b/Irpg/Utils.pm
index 6f77e69..8eea365 100644
--- a/Irpg/Utils.pm
+++ b/Irpg/Utils.pm
@@ -20,7 +20,7 @@ use warnings;
use Data::Dumper;
use Irpg::Irc qw(:interaction);
use Exporter qw(import);
-our @EXPORT = qw(&clog &debug);
+our @EXPORT = qw(&clog &debug &pronoun);
our @EXPORT_OK = qw(&set_debug_status &daemonize
&ts &mksalt &checksplits
&duration &pronoun
@@ -37,9 +37,10 @@ foreach (<Irpg/Classes/*.pm>) {
my $_configfile = '.irpg.conf';
+my $delayed_funcs = [];
my $opts;
-=head1 FUNCTION ts
+=head1 FUNCTION mksalt
This function returns a random salt for passwds
=cut
sub mksalt { # generate a random salt for passwds
@@ -47,7 +48,7 @@ sub mksalt { # generate a random salt for passwds
}
-=head1 FUNCTION ts
+=head1 FUNCTION pronoun
This function returns a pronoun fitting the given gender.
=over
=item SCALAR (int) - type of pronoun (1->subject, 2->possessive, 3->object)
@@ -69,7 +70,7 @@ sub pronoun {
'obj'=>'them'}->{$type};
}
-=head1 FUNCTION ts
+=head1 FUNCTION duration
This function returns a human readable duration.
=over
=item SCALAR (int) - number of seconds
@@ -245,8 +246,8 @@ sub loaddb { # load the players database
chomp($l);
next if $l =~ /^#/; # skip comments
my @i = split("\t",$l);
- print Dumper(@i) if @i != 46;
- if (@i != 46) {
+ print Dumper(@i) if @i != 45;
+ if (@i != 45) {
Irpg::Irc::sts("QUIT: Anomaly in loaddb(); line $. of $opts->{dbfile} has ".
"wrong fields (".scalar(@i).")");
debug("Anomaly in loaddb(); line $. of $opts->{dbfile} has wrong ".
@@ -297,17 +298,28 @@ sub loaddb { # load the players database
$classname,
$rps->{$i[0]}{points},
$rps->{$i[0]}{actions},
- $rps->{$i[0]}{next_a},
+ #$rps->{$i[0]}{next_a},
$rps->{$i[0]}{alignment},
$rps->{$i[0]}{gender}) = (@i[1..7],($startup?0:$i[8]),@i[9..$#i]);
- $classname =~ s/ /_/g;
+ $classname =~ s/ /_/g;
$rps->{$i[0]}{class} = eval 'Irpg::Classes::'.$classname.
'->new($rps->{$i[0]}{stats})';
+ $rps->{$i[0]}{next_a} = ();
}
close(RPS);
debug("loaddb(): loaded ".scalar(keys(%$rps))." accounts, ".
scalar(keys(%prev_online))." previously online.");
+
+ return unless (open(DELAYS, $opts->{actionsfile}));
+ while (<DELAYS>) {
+ chomp;
+ next if /^#/; # skip comments
+ my ($user, @delays) = split;
+ push @{$rps->{$user}{next_a}}, @delays;
+ }
+ close(DELAYS);
+
return \%prev_online;
}
@@ -322,6 +334,9 @@ sub writedb {
Irpg::Irc::chanmsg("ERROR: Cannot write $opts->{dbfile}: $!");
return 0;
};
+ my $open_delays = open(DELAYS, ">$opts->{actionsfile}");
+ debug("ERROR: Cannot write $opts->{actionsfile}: $!") unless ($open_delays);
+
print RPS join("\t","# username",
"pass",
"is admin",
@@ -365,7 +380,7 @@ sub writedb {
"class",
"points",
"actions",
- "next_a",
+ #"next_a",
"alignment",
"gender")."\n";
my $k;
@@ -415,12 +430,14 @@ sub writedb {
$rps->{$k}{class}->{NAME},
$rps->{$k}{points},
$rps->{$k}{actions},
- $rps->{$k}{next_a},
+ #$rps->{$k}{next_a},
$rps->{$k}{alignment},
$rps->{$k}{gender})."\n";
+ print DELAYS "$k ".join(' ', @{$rps->{$k}{next_a}})."\n" if ($open_delays);
}
}
close(RPS);
+ close(DELAYS) if ($open_delays);
}
=head1 FUNCTION createdb
@@ -509,4 +526,31 @@ sub checksplits { # removed expired split hosts from the hash
}
}
+=head1 FUNCTION execute_delayed
+ add an entry in the list of delayed functions
+ ordered by time to be called
+=over
+=item SCALAR - time when the function will be called
+=item SCALAR - function to be called
+=item ARRAY - arguments
+=back
+=cut
+sub execute_delayed {
+ my ($delay, $func, @args) = @_;
+ return unless (defined($delay) && defined($func));
+ my $time = $delay+time();
+ push @$delayed_funcs, [$time, $func, @args];
+ @$delayed_funcs = sort { $a->[0] <=> $b->[0] } @$delayed_funcs;
+ return $time;
+}
+
+sub exec_stack_delayed {
+ my $curtime = shift or return;
+ while (@$delayed_funcs
+ && $delayed_funcs->[0][0] <= $curtime) {
+ my @func = @{shift @$delayed_funcs};
+ $func[1]->(@func[2..$#func]);
+ }
+}
+
1;
--
GitLab