| 1 |
#! perl # mandatory |
| 2 |
|
| 3 |
our $WAIT_TIME = 5 * 60; # 5 minutes |
| 4 |
# the max price is base_price * 1.5 |
| 5 |
our $MAX_BASE_PRICE = 100 * 100 * 25; # 25 platinum (for lvl 115 players) |
| 6 |
our $MIN_BASE_PRICE = 100 * 10; # 10 gold |
| 7 |
|
| 8 |
sub calc_player_price { |
| 9 |
my ($name) = @_; |
| 10 |
|
| 11 |
if (my $player = cf::player::find $name) { |
| 12 |
my $price = ($player->ob->level / 115) * ($MAX_BASE_PRICE - $MIN_BASE_PRICE); |
| 13 |
return $MIN_BASE_PRICE + $price; |
| 14 |
|
| 15 |
} else { |
| 16 |
return $MIN_BASE_PRICE |
| 17 |
} |
| 18 |
} |
| 19 |
|
| 20 |
sub calc_text_price_ratio { |
| 21 |
my ($txt) = @_; |
| 22 |
|
| 23 |
if ($txt =~ /killed\s+by\s+foolery/) { |
| 24 |
return 0.001; # greatly punish foolery, the gravedigger doesn't like this! |
| 25 |
} |
| 26 |
|
| 27 |
my $some_constant = 111; |
| 28 |
|
| 29 |
my $cnt = 0; |
| 30 |
for (map ord $_, split //, $txt) { |
| 31 |
$cnt++; |
| 32 |
$cnt = $cnt % $some_constant; |
| 33 |
} |
| 34 |
|
| 35 |
my $ratio = (($some_constant - $cnt) / (2 * $some_constant)) + 1.0; |
| 36 |
$ratio |
| 37 |
} |
| 38 |
|
| 39 |
cf::register_script_function "gravedigger::buy_gravestones" => sub { |
| 40 |
my ($who, $msg, $npc) = @_; |
| 41 |
|
| 42 |
if ($who->flag (cf::FLAG_WIZ)) { |
| 43 |
delete $who->{gravedigger_last_time}; |
| 44 |
} |
| 45 |
|
| 46 |
if (defined $who->{gravedigger_last_time}) { |
| 47 |
my $waittime = time - $who->{gravedigger_last_time}; |
| 48 |
if ($waittime < $WAIT_TIME) { |
| 49 |
$who->reply ($npc, |
| 50 |
"I'm sorry sir, you have to wait until I stored the " |
| 51 |
. "previous stone you sold. " |
| 52 |
. "H<You have to wait " |
| 53 |
. int ((($WAIT_TIME - $waittime) / 60) + 0.5) |
| 54 |
. " minutes.>"); |
| 55 |
return; |
| 56 |
} |
| 57 |
} |
| 58 |
|
| 59 |
my (@stones) = cf::match::match |
| 60 |
'(type=SIGN and { $_->msg =~ /hero.*killed.*by/si }) in inv', |
| 61 |
$who; |
| 62 |
unless (@stones) { |
| 63 |
$who->reply ($npc, |
| 64 |
"I'm sorry sir, but you don't have any gravestones with you " |
| 65 |
. "I'm interested in! " |
| 66 |
. "H<He is only interested in gravestones caused by player deaths.>"); |
| 67 |
return; |
| 68 |
} |
| 69 |
|
| 70 |
cf::async { |
| 71 |
my $ston = $stones[0]; |
| 72 |
|
| 73 |
next unless $ston->msg =~ /the hero (\S+).*killed\s+by (.*)/s; |
| 74 |
my $player = $1; |
| 75 |
my $reason = $2; |
| 76 |
$reason =~ s/\.$//; |
| 77 |
$reason =~ s/\n+//g; |
| 78 |
|
| 79 |
my $player_price = calc_player_price ($player) |
| 80 |
or return; |
| 81 |
my $text_price_ratio = calc_text_price_ratio ($ston->msg); |
| 82 |
my $price = int ($player_price *= $text_price_ratio); |
| 83 |
|
| 84 |
$ston->decrease (1) |
| 85 |
unless $who->flag (cf::FLAG_WIZ); |
| 86 |
|
| 87 |
$who->pay_player ($price); |
| 88 |
|
| 89 |
my $price_txt = cf::cost_string_from_value $price; |
| 90 |
$who->reply ($npc, |
| 91 |
"I gave you $price_txt for the gravestone of " . $player . ". " |
| 92 |
. ($reason =~ /^\s*foolery/ |
| 93 |
? "Stupid fellow. Being foolish and making my job" |
| 94 |
. " harder than it already is kind of upsets me..." |
| 95 |
: "Poor fellow, $reason can be tricky...")); |
| 96 |
|
| 97 |
$who->{gravedigger_last_time} = time; |
| 98 |
}; |
| 99 |
|
| 100 |
$who->reply ($npc, "Let me have a look..."); |
| 101 |
}; |
| 102 |
|
