外挂编程

开发平台：

Windows_Unix

Misc.pm：源码内容

#########################################################################
# OpenKore - Miscellaneous functions
#
# This software is open source, licensed under the GNU General Public
# License, version 2.
# Basically, this means that you're allowed to modify and distribute
# this software. However, if you distribute modified versions, you MUST
# also distribute the source code.
# See http://www.gnu.org/licenses/gpl.html for the full license.
#
# $Revision: 6792 $
# $Id: Misc.pm 6792 2009-07-28 08:38:34Z klabmouse $
#
#########################################################################
##
# MODULE DESCRIPTION: Miscellaneous functions
#
# This module contains functions that do not belong in any other modules.
# The difference between Misc.pm and Utils.pm is that Misc.pm can have
# dependencies on other Kore modules.
package Misc;
use strict;
use Exporter;
use Carp::Assert;
use Data::Dumper;
use Compress::Zlib;
use base qw(Exporter);
use encoding 'utf8';
use Globals;
use Log qw(message warning error debug);
use Plugins;
use FileParsers;
use Settings;
use Utils;
use Utils::Assert;
use Skill;
use Field;
use Network;
use Network::Send ();
use AI;
use Actor;
use Actor::You;
use Actor::Player;
use Actor::Monster;
use Actor::Party;
use Actor::NPC;
use Actor::Portal;
use Actor::Pet;
use Actor::Slave;
use Actor::Unknown;
use Time::HiRes qw(time usleep);
use Translation;
use Utils::Exceptions;
our @EXPORT = (
# Config modifiers
qw/auth
configModify
bulkConfigModify
setTimeout
saveConfigFile/,
# Debugging
qw/debug_showSpots
visualDump/,
# Field math
qw/calcRectArea
calcRectArea2
checkLineSnipable
checkLineWalkable
checkWallLength
closestWalkableSpot
objectInsideSpell
objectIsMovingTowards
objectIsMovingTowardsPlayer/,
# Inventory management
qw/inInventory
inventoryItemRemoved
storageGet
cardName
itemName
itemNameSimple/,
# File Parsing and Writing
qw/chatLog
shopLog
monsterLog/,
# Logging
qw/itemLog/,
# OS specific
qw/launchURL/,
# Misc
qw/
actorAdded
actorRemoved
actorListClearing
avoidGM_talk
avoidList_talk
avoidList_ID
calcStat
center
charSelectScreen
chatLog_clear
checkAllowedMap
checkFollowMode
checkMonsterCleanness
createCharacter
deal
dealAddItem
drop
dumpData
getEmotionByCommand
getIDFromChat
getNPCName
getPlayerNameFromCache
getPortalDestName
getResponse
getSpellName
headgearName
initUserSeed
itemLog_clear
look
lookAtPosition
manualMove
meetingPosition
objectAdded
objectRemoved
items_control
pickupitems
mon_control
positionNearPlayer
positionNearPortal
printItemDesc
processNameRequestQueue
quit
relog
sendMessage
setSkillUseTimer
setPartySkillTimer
setStatus
countCastOn
stopAttack
stripLanguageCode
switchConfigFile
updateDamageTables
updatePlayerNameCache
useTeleport
top10Listing
whenGroundStatus
whenStatusActive
whenStatusActiveMon
whenStatusActivePL
writeStorageLog
getBestTarget
isSafe/,
# Actor's Actions Text
qw/attack_string
skillCast_string
skillUse_string
skillUseLocation_string
skillUseNoDamage_string
status_string/,
# AI Math
qw/lineIntersection
percent_hp
percent_sp
percent_weight/,
# Misc Functions
qw/avoidGM_near
avoidList_near
compilePortals
compilePortals_check
portalExists
portalExists2
redirectXKoreMessages
monKilled
getActorName
getActorNames
findPartyUserID
getNPCInfo
skillName
checkSelfCondition
checkPlayerCondition
checkMonsterCondition
findCartItemInit
findCartItem
makeShop
openShop
closeShop
inLockMap
parseReload/
);
# use SelfLoader; 1;
# __DATA__
sub _checkActorHash($$$$) {
my ($name, $hash, $type, $hashName) = @_;
foreach my $actor (values %{$hash}) {
if (!UNIVERSAL::isa($actor, $type)) {
die "$namenUnblessed item in $hashName list:n" .
Dumper($hash);
}
}
}
# Checks whether the internal state of some variables are correct.
sub checkValidity {
return if (!DEBUG || $ENV{OPENKORE_NO_CHECKVALIDITY});
my ($name) = @_;
$name = "Validity check:" if (!defined $name);
assertClass($char, 'Actor::You') if ($net && $net->getState() == Network::IN_GAME
&& $net->isa('Network::XKore'));
assertClass($char, 'Actor::You') if ($char);
return;
_checkActorHash($name, %items, 'Actor::Item', 'item');
_checkActorHash($name, %monsters, 'Actor::Monster', 'monster');
_checkActorHash($name, %players, 'Actor::Player', 'player');
_checkActorHash($name, %pets, 'Actor::Pet', 'pet');
_checkActorHash($name, %npcs, 'Actor::NPC', 'NPC');
_checkActorHash($name, %portals, 'Actor::Portal', 'portals');
}
#######################################
#######################################
### CATEGORY: Configuration modifiers
#######################################
#######################################
sub auth {
my $user = shift;
my $flag = shift;
if ($flag) {
message TF("Authorized user '%s' for adminn", $user), "success";
} else {
message TF("Revoked admin privilages for user '%s'n", $user), "success";
}
$overallAuth{$user} = $flag;
writeDataFile(Settings::getControlFilename("overallAuth.txt"), %overallAuth);
}
##
# void configModify(String key, String value, ...)
# key: a key name.
# value: the new value.
#
# Changes the value of the configuration option $key to $value.
# Both %config and config.txt will be updated.
#
# You may also call configModify() with additional optional options:
# `l
# - autoCreate (boolean): Whether the configuration option $key
# should be created if it doesn't already exist.
# The default is true.
# - silent (boolean): By default, output will be printed, notifying the user
# that a config option has been changed. Setting this to
# true will surpress that output.
# `l`
sub configModify {
my $key = shift;
my $val = shift;
my %args;
if (@_ == 1) {
$args{silent} = $_[0];
} else {
%args = @_;
}
$args{autoCreate} = 1 if (!exists $args{autoCreate});
Plugins::callHook('configModify', {
key => $key,
val => $val,
additionalOptions => %args
});
if (!$args{silent} && $key !~ /password/i) {
my $oldval = $config{$key};
if (!defined $oldval) {
$oldval = "not set";
}
if (!defined $val) {
message TF("Config '%s' unset (was %s)n", $key, $oldval), "info";
} else {
message TF("Config '%s' set to %s (was %s)n", $key, $val, $oldval), "info";
}
}
if ($args{autoCreate} && !exists $config{$key}) {
my $f;
if (open($f, ">>", Settings::getConfigFilename())) {
print $f "$keyn";
close($f);
}
}
$config{$key} = $val;
saveConfigFile();
}
##
# bulkConfigModify (r_hash, [silent])
# r_hash: key => value to change
# silent: if set to 1, do not print a message to the console.
#
# like configModify but for more than one value at the same time.
sub bulkConfigModify {
my $r_hash = shift;
my $silent = shift;
my $oldval;
foreach my $key (keys %{$r_hash}) {
Plugins::callHook('configModify', {
key => $key,
val => $r_hash->{$key},
silent => $silent
});
$oldval = $config{$key};
$config{$key} = $r_hash->{$key};
if ($key =~ /password/i) {
message TF("Config '%s' set to %s (was *not-displayed*)n", $key, $r_hash->{$key}), "info" unless ($silent);
} else {
message TF("Config '%s' set to %s (was %s)n", $key, $r_hash->{$key}, $oldval), "info" unless ($silent);
}
}
saveConfigFile();
}
##
# saveConfigFile()
#
# Writes %config to config.txt.
sub saveConfigFile {
writeDataFileIntact(Settings::getConfigFilename(), %config);
}
sub setTimeout {
my $timeout = shift;
my $time = shift;
message TF("Timeout '%s' set to %s (was %s)n", $timeout, $time, $timeout{$timeout}{timeout}), "info";
$timeout{$timeout}{'timeout'} = $time;
writeDataFileIntact2(Settings::getControlFilename("timeouts.txt"), %timeout);
}
#######################################
#######################################
### Category: Debugging
#######################################
#######################################
our %debug_showSpots_list;
sub debug_showSpots {
return unless $net->clientAlive();
my $ID = shift;
my $spots = shift;
my $special = shift;
if ($debug_showSpots_list{$ID}) {
foreach (@{$debug_showSpots_list{$ID}}) {
my $msg = pack("C*", 0x20, 0x01) . pack("V", $_);
$net->clientSend($msg);
}
}
my $i = 1554;
$debug_showSpots_list{$ID} = [];
foreach (@{$spots}) {
next if !defined $_;
my $msg = pack("C*", 0x1F, 0x01)
. pack("V*", $i, 1550)
. pack("v*", $_->{x}, $_->{y})
. pack("C*", 0x93, 0);
$net->clientSend($msg);
$net->clientSend($msg);
push @{$debug_showSpots_list{$ID}}, $i;
$i++;
}
if ($special) {
my $msg = pack("C*", 0x1F, 0x01)
. pack("V*", 1553, 1550)
. pack("v*", $special->{x}, $special->{y})
. pack("C*", 0x83, 0);
$net->clientSend($msg);
$net->clientSend($msg);
push @{$debug_showSpots_list{$ID}}, 1553;
}
}
##
# visualDump(data [, label])
#
# Show the bytes in $data on screen as hexadecimal.
# Displays the label if provided.
sub visualDump {
my ($msg, $label) = @_;
my $dump;
my $puncations = quotemeta '~!@#$%^&*()_-+=|"'';
no encoding 'utf8';
use bytes;
$dump = "================================================n";
if (defined $label) {
$dump .= sprintf("%-15s [%d bytes] %sn", $label, length($msg), getFormattedDate(int(time)));
} else {
$dump .= sprintf("%d bytes %sn", length($msg), getFormattedDate(int(time)));
}
for (my $i = 0; $i < length($msg); $i += 16) {
my $line;
my $data = substr($msg, $i, 16);
my $rawData = '';
for (my $j = 0; $j < length($data); $j++) {
my $char = substr($data, $j, 1);
if (ord($char) < 32 || ord($char) > 126) {
$rawData .= '.';
} else {
$rawData .= substr($data, $j, 1);
}
}
$line = getHex(substr($data, 0, 8));
$line .= ' ' . getHex(substr($data, 8)) if (length($data) > 8);
$line .= ' ' x (50 - length($line)) if (length($line) < 54);
$line .= " $rawDatan";
$line = sprintf("%3d> ", $i) . $line;
$dump .= $line;
}
message $dump;
}
#######################################
#######################################
### CATEGORY: Field math
#######################################
#######################################
##
# calcRectArea($x, $y, $radius)
# Returns: an array with position hashes. Each has contains an x and a y key.
#
# Creates a rectangle with center ($x,$y) and radius $radius,
# and returns a list of positions of the border of the rectangle.
sub calcRectArea {
my ($x, $y, $radius) = @_;
my (%topLeft, %topRight, %bottomLeft, %bottomRight);
sub capX {
return 0 if ($_[0] < 0);
return $field{width} - 1 if ($_[0] >= $field{width});
return int $_[0];
}
sub capY {
return 0 if ($_[0] < 0);
return $field{height} - 1 if ($_[0] >= $field{height});
return int $_[0];
}
# Get the avoid area as a rectangle
$topLeft{x} = capX($x - $radius);
$topLeft{y} = capY($y + $radius);
$topRight{x} = capX($x + $radius);
$topRight{y} = capY($y + $radius);
$bottomLeft{x} = capX($x - $radius);
$bottomLeft{y} = capY($y - $radius);
$bottomRight{x} = capX($x + $radius);
$bottomRight{y} = capY($y - $radius);
# Walk through the border of the rectangle
# Record the blocks that are walkable
my @walkableBlocks;
for (my $x = $topLeft{x}; $x <= $topRight{x}; $x++) {
if ($field->isWalkable($x, $topLeft{y})) {
push @walkableBlocks, {x => $x, y => $topLeft{y}};
}
}
for (my $x = $bottomLeft{x}; $x <= $bottomRight{x}; $x++) {
if ($field->isWalkable($x, $bottomLeft{y})) {
push @walkableBlocks, {x => $x, y => $bottomLeft{y}};
}
}
for (my $y = $bottomLeft{y} + 1; $y < $topLeft{y}; $y++) {
if ($field->isWalkable($topLeft{x}, $y)) {
push @walkableBlocks, {x => $topLeft{x}, y => $y};
}
}
for (my $y = $bottomRight{y} + 1; $y < $topRight{y}; $y++) {
if ($field->isWalkable($topLeft{x}, $y)) {
push @walkableBlocks, {x => $topRight{x}, y => $y};
}
}
return @walkableBlocks;
}
##
# calcRectArea2($x, $y, $radius, $minRange)
# Returns: an array with position hashes. Each has contains an x and a y key.
#
# Creates a rectangle with center ($x,$y) and radius $radius,
# and returns a list of positions inside the rectangle that are
# not closer than $minRange to the center.
sub calcRectArea2 {
my ($cx, $cy, $r, $min) = @_;
my @rectangle;
for (my $x = $cx - $r; $x <= $cx + $r; $x++) {
for (my $y = $cy - $r; $y <= $cy + $r; $y++) {
next if distance({x => $cx, y => $cy}, {x => $x, y => $y}) < $min;
push(@rectangle, {x => $x, y => $y});
}
}
return @rectangle;
}
##
# checkLineSnipable(from, to)
# from, to: references to position hashes.
#
# Check whether you can snipe a target standing at $to,
# from the position $from, without being blocked by any
# obstacles.
sub checkLineSnipable {
return 0 if (!$field);
my $from = shift;
my $to = shift;
# Simulate tracing a line to the location (modified Bresenham's algorithm)
my ($X0, $Y0, $X1, $Y1) = ($from->{x}, $from->{y}, $to->{x}, $to->{y});
my $steep;
my $posX = 1;
my $posY = 1;
if ($X1 - $X0 < 0) {
$posX = -1;
}
if ($Y1 - $Y0 < 0) {
$posY = -1;
}
if (abs($Y0 - $Y1) < abs($X0 - $X1)) {
$steep = 0;
} else {
$steep = 1;
}
if ($steep == 1) {
my $Yt = $Y0;
$Y0 = $X0;
$X0 = $Yt;
$Yt = $Y1;
$Y1 = $X1;
$X1 = $Yt;
}
if ($X0 > $X1) {
my $Xt = $X0;
$X0 = $X1;
$X1 = $Xt;
my $Yt = $Y0;
$Y0 = $Y1;
$Y1 = $Yt;
}
my $dX = $X1 - $X0;
my $dY = abs($Y1 - $Y0);
my $E = 0;
my $dE;
if ($dX) {
$dE = $dY / $dX;
} else {
# Delta X is 0, it only occures when $from is equal to $to
return 1;
}
my $stepY;
if ($Y0 < $Y1) {
$stepY = 1;
} else {
$stepY = -1;
}
my $Y = $Y0;
my $Erate = 0.99;
if (($posY == -1 && $posX == 1) || ($posY == 1 && $posX == -1)) {
$Erate = 0.01;
}
for (my $X=$X0;$X<=$X1;$X++) {
$E += $dE;
if ($steep == 1) {
return 0 if (!$field->isSnipable($Y, $X));
} else {
return 0 if (!$field->isSnipable($X, $Y));
}
if ($E >= $Erate) {
$Y += $stepY;
$E -= 1;
}
}
return 1;
}
##
# checkLineWalkable(from, to, [min_obstacle_size = 5])
# from, to: references to position hashes.
#
# Check whether you can walk from $from to $to in an (almost)
# straight line, without obstacles that are too large.
# Obstacles are considered too large, if they are at least
# the size of a rectangle with "radius" $min_obstacle_size.
sub checkLineWalkable {
return 0 if (!$field);
my $from = shift;
my $to = shift;
my $min_obstacle_size = shift;
$min_obstacle_size = 5 if (!defined $min_obstacle_size);
my $dist = round(distance($from, $to));
my %vec;
getVector(%vec, $to, $from);
# Simulate walking from $from to $to
for (my $i = 1; $i < $dist; $i++) {
my %p;
moveAlongVector(%p, $from, %vec, $i);
$p{x} = int $p{x};
$p{y} = int $p{y};
if ( !$field->isWalkable($p{x}, $p{y}) ) {
# The current spot is not walkable. Check whether
# this the obstacle is small enough.
if (checkWallLength(%p, -1, 0, $min_obstacle_size) || checkWallLength(%p, 1, 0, $min_obstacle_size)
|| checkWallLength(%p, 0, -1, $min_obstacle_size) || checkWallLength(%p, 0, 1, $min_obstacle_size)
|| checkWallLength(%p, -1, -1, $min_obstacle_size) || checkWallLength(%p, 1, 1, $min_obstacle_size)
|| checkWallLength(%p, 1, -1, $min_obstacle_size) || checkWallLength(%p, -1, 1, $min_obstacle_size)) {
return 0;
}
}
}
return 1;
}
sub checkWallLength {
my $pos = shift;
my $dx = shift;
my $dy = shift;
my $length = shift;
my $x = $pos->{x};
my $y = $pos->{y};
my $len = 0;
do {
last if ($x < 0 || $x >= $field{width} || $y < 0 || $y >= $field{height});
$x += $dx;
$y += $dy;
$len++;
} while (!$field->isWalkable($x, $y) && $len < $length);
return $len >= $length;
}
##
# closestWalkableSpot(r_field, pos)
# r_field: a reference to a field hash.
# pos: reference to a position hash (which contains 'x' and 'y' keys).
# Returns: 1 if %pos has been modified, 0 of not.
#
# If the position specified in $pos is walkable, this function will do nothing.
# If it's not walkable, this function will find the closest position that is walkable (up to 2 blocks away),
# and modify the x and y values in $pos.
sub closestWalkableSpot {
my $field = shift;
my $pos = shift;
foreach my $z ( [0,0], [0,1],[1,0],[0,-1],[-1,0], [-1,1],[1,1],[1,-1],[-1,-1],[0,2],[2,0],[0,-2],[-2,0] ) {
next if !$field->isWalkable($pos->{x} + $z->[0], $pos->{y} + $z->[1]);
$pos->{x} += $z->[0];
$pos->{y} += $z->[1];
return 1;
}
return 0;
}
##
# objectInsideSpell(object, [ignore_party_members = 1])
# object: reference to a player or monster hash.
#
# Checks whether an object is inside someone else's spell area.
# (Traps are also "area spells").
sub objectInsideSpell {
my $object = shift;
my $ignore_party_members = shift;
$ignore_party_members = 1 if (!defined $ignore_party_members);
my ($x, $y) = ($object->{pos_to}{x}, $object->{pos_to}{y});
foreach (@spellsID) {
my $spell = $spells{$_};
if ((!$ignore_party_members || !$char->{party} || !$char->{party}{users}{$spell->{sourceID}})
&& $spell->{sourceID} ne $accountID
&& $spell->{pos}{x} == $x && $spell->{pos}{y} == $y) {
return 1;
}
}
return 0;
}
##
# objectIsMovingTowards(object1, object2, [max_variance])
#
# Check whether $object1 is moving towards $object2.
sub objectIsMovingTowards {
my $obj = shift;
my $obj2 = shift;
my $max_variance = (shift || 15);
if (!timeOut($obj->{time_move}, $obj->{time_move_calc})) {
# $obj is still moving
my %vec;
getVector(%vec, $obj->{pos_to}, $obj->{pos});
return checkMovementDirection($obj->{pos}, %vec, $obj2->{pos_to}, $max_variance);
}
return 0;
}
##
# objectIsMovingTowardsPlayer(object, [ignore_party_members = 1])
#
# Check whether an object is moving towards a player.
sub objectIsMovingTowardsPlayer {
my $obj = shift;
my $ignore_party_members = shift;
$ignore_party_members = 1 if (!defined $ignore_party_members);
if (!timeOut($obj->{time_move}, $obj->{time_move_calc}) && @playersID) {
# Monster is still moving, and there are players on screen
my %vec;
getVector(%vec, $obj->{pos_to}, $obj->{pos});
my $players = $playersList->getItems();
foreach my $player (@{$players}) {
my $ID = $player->{ID};
next if (
($ignore_party_members && $char->{party} && $char->{party}{users}{$ID})
|| (defined($player->{name}) && existsInList($config{tankersList}, $player->{name}))
|| $player->{statuses}{"GM Perfect Hide"});
if (checkMovementDirection($obj->{pos}, %vec, $player->{pos}, 15)) {
return 1;
}
}
}
return 0;
}
#########################################
#########################################
### CATEGORY: Logging
#########################################
#########################################
sub itemLog {
my $crud = shift;
return if (!$config{'itemHistory'});
open ITEMLOG, ">>:utf8", $Settings::item_log_file;
print ITEMLOG "[".getFormattedDate(int(time))."] $crud";
close ITEMLOG;
}
sub chatLog {
my $type = shift;
my $message = shift;
open CHAT, ">>:utf8", $Settings::chat_log_file;
print CHAT "[".getFormattedDate(int(time))."][".uc($type)."] $message";
close CHAT;
}
sub shopLog {
my $crud = shift;
open SHOPLOG, ">>:utf8", $Settings::shop_log_file;
print SHOPLOG "[".getFormattedDate(int(time))."] $crud";
close SHOPLOG;
}
sub monsterLog {
my $crud = shift;
return if (!$config{'monsterLog'});
open MONLOG, ">>:utf8", $Settings::monster_log_file;
print MONLOG "[".getFormattedDate(int(time))."] $crudn";
close MONLOG;
}
#########################################
#########################################
### CATEGORY: Operating system specific
#########################################
#########################################
##
# launchURL(url)
#
# Open $url in the operating system's preferred web browser.
sub launchURL {
my $url = shift;
if ($^O eq 'MSWin32') {
require Utils::Win32;
Utils::Win32::ShellExecute(0, undef, $url);
} else {
my $mod = 'use POSIX;';
eval $mod;
# This is a script I wrote for the autopackage project
# It autodetects the current desktop environment
my $detectionScript = <<EOF;
function detectDesktop() {
if [[ "$DISPLAY" = "" ]]; then
return 1
fi
local LC_ALL=C
local clients
if ! clients=`xlsclients`; then
return 1
fi
if echo "$clients" | grep -qE '(gnome-panel|nautilus|metacity)'; then
echo gnome
elif echo "$clients" | grep -qE '(kicker|slicker|karamba|kwin)'; then
echo kde
else
echo other
fi
return 0
}
detectDesktop
EOF
my ($r, $w, $desktop);
my $pid = IPC::Open2::open2($r, $w, '/bin/bash');
print $w $detectionScript;
close $w;
$desktop = <$r>;
$desktop =~ s/n//;
close $r;
waitpid($pid, 0);
sub checkCommand {
foreach (split(/:/, $ENV{PATH})) {
return 1 if (-x "$_/$_[0]");
}
return 0;
}
if ($desktop eq "gnome" && checkCommand('gnome-open')) {
launchApp(1, 'gnome-open', $url);
} elsif ($desktop eq "kde") {
launchApp(1, 'kfmclient', 'exec', $url);
} else {
if (checkCommand('firefox')) {
launchApp(1, 'firefox', $url);
} elsif (checkCommand('mozillaa')) {
launchApp(1, 'mozilla', $url);
} else {
$interface->errorDialog(TF("No suitable browser detected. Please launch your favorite browser and go to:n%s", $url));
}
}
}
}
#######################################
#######################################
### CATEGORY: Other functions
#######################################
#######################################
sub actorAddedRemovedVars {
my ($source) = @_;
# returns (type, list, hash)
if ($source == $itemsList) {
return ('item', @itemsID, %items);
} elsif ($source == $playersList) {
return ('player', @playersID, %players);
} elsif ($source == $monstersList) {
return ('monster', @monstersID, %monsters);
} elsif ($source == $portalsList) {
return ('portal', @portalsID, %portals);
} elsif ($source == $petsList) {
return ('pet', @petsID, %pets);
} elsif ($source == $npcsList) {
return ('npc', @npcsID, %npcs);
} elsif ($source == $slavesList) {
return ('slave', @slavesID, %slaves);
} else {
return (undef, undef, undef);
}
}
sub actorAdded {
my (undef, $source, $arg) = @_;
my ($actor, $index) = @{$arg};
$actor->{binID} = $index;
my ($type, $list, $hash) = actorAddedRemovedVars ($source);
if (defined $type) {
if (DEBUG && scalar(keys %{$hash}) + 1 != $source->size()) {
use Data::Dumper;
my $ol = '';
my $items = $source->getItems();
foreach my $item (@{$items}) {
$ol .= $item->nameIdx . "n";
}
die "$type: " . scalar(keys %{$hash}) . " + 1 != " . $source->size() . "n" .
"List:n" .
Dumper($list) . "n" .
"Hash:n" .
Dumper($hash) . "n" .
"ObjectList:n" .
$ol;
}
assert(binSize($list) + 1 == $source->size()) if DEBUG;
binAdd($list, $actor->{ID});
$hash->{$actor->{ID}} = $actor;
objectAdded($type, $actor->{ID}, $actor);
assert(scalar(keys %{$hash}) == $source->size()) if DEBUG;
assert(binSize($list) == $source->size()) if DEBUG;
}
}
sub actorRemoved {
my (undef, $source, $arg) = @_;
my ($actor, $index) = @{$arg};
my ($type, $list, $hash) = actorAddedRemovedVars ($source);
if (defined $type) {
if (DEBUG && scalar(keys %{$hash}) - 1 != $source->size()) {
use Data::Dumper;
my $ol = '';
my $items = $source->getItems();
foreach my $item (@{$items}) {
$ol .= $item->nameIdx . "n";
}
die "$type:" . scalar(keys %{$hash}) . " - 1 != " . $source->size() . "n" .
"List:n" .
Dumper($list) . "n" .
"Hash:n" .
Dumper($hash) . "n" .
"ObjectList:n" .
$ol;
}
assert(binSize($list) - 1 == $source->size()) if DEBUG;
binRemove($list, $actor->{ID});
delete $hash->{$actor->{ID}};
objectRemoved($type, $actor->{ID}, $actor);
if ($type eq "player") {
binRemove(@venderListsID, $actor->{ID});
delete $venderLists{$actor->{ID}};
}
assert(scalar(keys %{$hash}) == $source->size()) if DEBUG;
assert(binSize($list) == $source->size()) if DEBUG;
}
}
sub actorListClearing {
undef %items;
undef %players;
undef %monsters;
undef %portals;
undef %npcs;
undef %pets;
undef %slaves;
undef @itemsID;
undef @playersID;
undef @monstersID;
undef @portalsID;
undef @npcsID;
undef @petsID;
undef @slavesID;
}
sub avoidGM_talk {
return 0 if ($net->clientAlive() || !$config{avoidGM_talk});
my ($user, $msg) = @_;
# Check whether this "GM" is on the ignore list
# in order to prevent false matches
return 0 if (existsInList($config{avoidGM_ignoreList}, $user));
if ($user =~ /^([a-z]?ro)?-?(Sub)?-?[?GM]?/i || $user =~ /$config{avoidGM_namePattern}/) {
my %args = (
name => $user,
);
Plugins::callHook('avoidGM_talk', %args);
return 1 if ($args{return});
warning T("Disconnecting to avoid GM!n");
main::chatLog("k", TF("*** The GM %s talked to you, auto disconnected ***n", $user));
warning TF("Disconnect for %s seconds...n", $config{avoidGM_reconnect});
relog($config{avoidGM_reconnect}, 1);
return 1;
}
return 0;
}
sub avoidList_talk {
return 0 if ($net->clientAlive() || !$config{avoidList});
my ($user, $msg, $ID) = @_;
if ($avoid{Players}{lc($user)}{disconnect_on_chat} || $avoid{ID}{$ID}{disconnect_on_chat}) {
warning TF("Disconnecting to avoid %s!n", $user);
main::chatLog("k", TF("*** %s talked to you, auto disconnected ***n", $user));
warning TF("Disconnect for %s seconds...n", $config{avoidList_reconnect});
relog($config{avoidList_reconnect}, 1);
return 1;
}
return 0;
}
sub calcStat {
my $damage = shift;
$totaldmg += $damage;
}
##
# center(string, width, [fill])
#
# This function will center $string within a field $width characters wide,
# using $fill characters for padding on either end of the string for
# centering. If $fill is not specified, a space will be used.
sub center {
my ($string, $width, $fill) = @_;
$fill ||= ' ';
my $left = int(($width - length($string)) / 2);
my $right = ($width - length($string)) - $left;
return $fill x $left . $string . $fill x $right;
}
# Returns: 0 if user chose to quit, 1 if user chose a character, 2 if user created or deleted a character
sub charSelectScreen {
my %plugin_args = (autoLogin => shift);
# A list of character names
my @charNames;
# An array which maps an index in @charNames to an index in @chars
my @charNameIndices;
my $mode;
TOP: {
undef $mode;
@charNames = ();
@charNameIndices = ();
}
for (my $num = 0; $num < @chars; $num++) {
next unless ($chars[$num] && %{$chars[$num]});
if (0) {
# The old (more verbose) message
swrite(
T("------- Character @< ---------n" .
"Name: @<<<<<<<<<<<<<<<<<<<<<<<<n" .
"Job: @<<<<<<< Job Exp: @<<<<<<<n" .
"Lv: @<<<<<<< Str: @<<<<<<<<n" .
"J.Lv: @<<<<<<< Agi: @<<<<<<<<n" .
"Exp: @<<<<<<< Vit: @<<<<<<<<n" .
"HP: @||||/@|||| Int: @<<<<<<<<n" .
"SP: @||||/@|||| Dex: @<<<<<<<<n" .
"Zenny: @<<<<<<<<<< Luk: @<<<<<<<<n" .
"-------------------------------"),
$num, $chars[$num]{'name'}, $jobs_lut{$chars[$num]{'jobID'}}, $chars[$num]{'exp_job'},
$chars[$num]{'lv'}, $chars[$num]{'str'}, $chars[$num]{'lv_job'}, $chars[$num]{'agi'},
$chars[$num]{'exp'}, $chars[$num]{'vit'}, $chars[$num]{'hp'}, $chars[$num]{'hp_max'},
$chars[$num]{'int'}, $chars[$num]{'sp'}, $chars[$num]{'sp_max'}, $chars[$num]{'dex'},
$chars[$num]{'zenny'}, $chars[$num]{'luk'});
}
push @charNames, TF("Slot %d: %s (%s, level %d/%d)",
$num,
$chars[$num]{name},
$jobs_lut{$chars[$num]{'jobID'}},
$chars[$num]{lv},
$chars[$num]{lv_job});
push @charNameIndices, $num;
}
if (@charNames) {
message(TF("------------- Character List -------------n" .
"%sn" .
"------------------------------------------n",
join("n", @charNames)),
"connection");
}
return 1 if $net->clientAlive;
Plugins::callHook('charSelectScreen', %plugin_args);
return $plugin_args{return} if ($plugin_args{return});
if ($plugin_args{autoLogin} && @chars && $config{char} ne "" && $chars[$config{char}]) {
$messageSender->sendCharLogin($config{char});
$timeout{charlogin}{time} = time;
return 1;
}
if (@chars) {
my @choices = @charNames;
push @choices, (T('Create a new character'), T('Delete a character'));
my $choice = $interface->showMenu(
T("Please choose a character or an action."), @choices,
title => T("Character selection"));
if ($choice == -1) {
# User cancelled
quit();
return 0;
} elsif ($choice < @charNames) {
# Character chosen
configModify('char', $charNameIndices[$choice], 1);
$messageSender->sendCharLogin($config{char});
$timeout{charlogin}{time} = time;
return 1;
} elsif ($choice == @charNames) {
# 'Create character' chosen
$mode = "create";
} else {
# 'Delete character' chosen
$mode = "delete";
}
} else {
message T("There are no characters on this account.n"), "connection";
$mode = "create";
}
if ($mode eq "create") {
while (1) {
my $message = T("Please enter the desired properties for your characters, in this form:n" .
"(slot) "(name)" [ (str) (agi) (vit) (int) (dex) (luk) [ (hairstyle) [(haircolor)] ] ]");
my $input = $interface->query($message);
if (!defined($input)) {
goto TOP;
} else {
my @args = parseArgs($input);
if (@args < 2) {
$interface->errorDialog(T("You didn't specify enough parameters."), 0);
next;
}
message TF("Creating character "%s" in slot "%s"...n", $args[1], $args[0]), "connection";
$timeout{charlogin}{time} = time;
last if (createCharacter(@args));
}
}
} elsif ($mode eq "delete") {
my $choice = $interface->showMenu(
T("Select the character you want to delete."),
@charNames,
title => T("Delete character"));
if ($choice == -1) {
goto TOP;
}
my $charIndex = @charNameIndices[$choice];
my $email = $interface->query("Enter your email address.");
if (!defined($email)) {
goto TOP;
}
my $confirmation = $interface->showMenu(
TF("Are you ABSOLUTELY SURE you want to delete:n%s", $charNames[$choice]),
[T("No, don't delete"), T("Yes, delete")],
title => T("Confirm delete"));
if ($confirmation != 1) {
goto TOP;
}
$messageSender->sendCharDelete($chars[$charIndex]{charID}, $email);
message TF("Deleting character %s...n", $chars[$charIndex]{name}), "connection";
$AI::temp::delIndex = $charIndex;
$timeout{charlogin}{time} = time;
}
return 2;
}
sub chatLog_clear {
if (-f $Settings::chat_log_file) {
unlink($Settings::chat_log_file);
}
}
##
# checkAllowedMap($map)
#
# Checks whether $map is in $config{allowedMaps}.
# Disconnects if it is not, and $config{allowedMaps_reaction} != 0.
sub checkAllowedMap {
my $map = shift;
return unless $AI == 2;
return unless $config{allowedMaps};
return if existsInList($config{allowedMaps}, $map);
return if $config{allowedMaps_reaction} == 0;
warning TF("The current map (%s) is not on the list of allowed maps.n", $map);
main::chatLog("k", TF("** The current map (%s) is not on the list of allowed maps.n", $map));
main::chatLog("k", T("** Exiting...n"));
quit();
}
##
# checkFollowMode()
# Returns: 1 if in follow mode, 0 if not.
#
# Check whether we're current in follow mode.
sub checkFollowMode {
my $followIndex;
if ($config{follow} && defined($followIndex = AI::findAction("follow"))) {
return 1 if (AI::args($followIndex)->{following});
}
return 0;
}
##
# boolean checkMonsterCleanness(Bytes ID)
# ID: the monster's ID.
# Requires: $ID is a valid monster ID.
#
# Checks whether a monster is "clean" (not being attacked by anyone).
sub checkMonsterCleanness {
return 1 if (!$config{attackAuto});
my $ID = $_[0];
return 1 if ($playersList->getByID($ID));
my $monster = $monstersList->getByID($ID);
# If party attacked monster, or if monster attacked/missed party
if ($monster->{dmgFromParty} > 0 || $monster->{dmgToParty} > 0 || $monster->{missedToParty} > 0) {
return 1;
}
if ($config{aggressiveAntiKS}) {
# Aggressive anti-KS mode, for people who are paranoid about not kill stealing.
# If we attacked the monster first, do not drop it, we are being KSed
return 1 if ($monster->{dmgFromYou} || $monster->{missedFromYou});
# If others attacked the monster then always drop it, wether it attacked us or not!
return 0 if (($monster->{dmgFromPlayer} && %{$monster->{dmgFromPlayer}})
|| ($monster->{missedFromPlayer} && %{$monster->{missedFromPlayer}})
|| (($monster->{castOnByPlayer}) && %{$monster->{castOnByPlayer}})
|| (($monster->{castOnToPlayer}) && %{$monster->{castOnToPlayer}}));
}
# If monster attacked/missed you
return 1 if ($monster->{'dmgToYou'} || $monster->{'missedYou'});
# If we're in follow mode
if (defined(my $followIndex = AI::findAction("follow"))) {
my $following = AI::args($followIndex)->{following};
my $followID = AI::args($followIndex)->{ID};
if ($following) {
# And master attacked monster, or the monster attacked/missed master
if ($monster->{dmgToPlayer}{$followID} > 0
|| $monster->{missedToPlayer}{$followID} > 0
|| $monster->{dmgFromPlayer}{$followID} > 0) {
return 1;
}
}
}
if (objectInsideSpell($monster)) {
# Prohibit attacking this monster in the future
$monster->{dmgFromPlayer}{$char->{ID}} = 1;
return 0;
}
#check party casting on mob
my $allowed = 1;
if (scalar(keys %{$monster->{castOnByPlayer}}) > 0)
{
foreach (keys %{$monster->{castOnByPlayer}})
{
my $ID1=$_;
my $source = Actor::get($_);
unless ( existsInList($config{tankersList}, $source->{name}) ||
($char->{party} && %{$char->{party}} && $char->{party}{users}{$ID1} && %{$char->{party}{users}{$ID1}}))
{
$allowed = 0;
last;
}
}
}
# If monster hasn't been attacked by other players
if (scalar(keys %{$monster->{missedFromPlayer}}) == 0
&& scalar(keys %{$monster->{dmgFromPlayer}}) == 0
#&& scalar(keys %{$monster->{castOnByPlayer}}) == 0 #change to $allowed
&& $allowed
# and it hasn't attacked any other player
&& scalar(keys %{$monster->{missedToPlayer}}) == 0
&& scalar(keys %{$monster->{dmgToPlayer}}) == 0
&& scalar(keys %{$monster->{castOnToPlayer}}) == 0
) {
# The monster might be getting lured by another player.
# So we check whether it's walking towards any other player, but only
# if we haven't already attacked the monster.
if ($monster->{dmgFromYou} || $monster->{missedFromYou}) {
return 1;
} else {
return !objectIsMovingTowardsPlayer($monster);
}
}
# The monster didn't attack you.
# Other players attacked it, or it attacked other players.
if ($monster->{dmgFromYou} || $monster->{missedFromYou}) {
# If you have already attacked the monster before, then consider it clean
return 1;
}
# If you haven't attacked the monster yet, it's unclean.
return 0;
}
##
# boolean createCharacter(int slot, String name, int [str,agi,vit,int,dex,luk] = 5)
# slot: The slot in which to create the character (1st slot is 0).
# name: The name of the character to create.
# Returns: Whether the parameters are correct. Only a character creation command
# will be sent to the server if all parameters are correct.
#
# Create a new character. You must be currently connected to the character login server.
sub createCharacter {
my $slot = shift;
my $name = shift;
my ($str,$agi,$vit,$int,$dex,$luk, $hair_style, $hair_color) = @_;
if (!@_) {
($str,$agi,$vit,$int,$dex,$luk) = (5,5,5,5,5,5);
}
if ($net->getState() != 3) {
$interface->errorDialog(T("We're not currently connected to the character login server."), 0);
return 0;
} elsif ($slot !~ /^d+$/) {
$interface->errorDialog(TF("Slot "%s" is not a valid number.", $slot), 0);
return 0;
} elsif ($slot < 0 || $slot > 4) {
$interface->errorDialog(T("The slot must be comprised between 0 and 4."), 0);
return 0;
} elsif ($chars[$slot]) {
$interface->errorDialog(TF("Slot %s already contains a character (%s).", $slot, $chars[$slot]{name}), 0);
return 0;
} elsif (length($name) > 23) {
$interface->errorDialog(T("Name must not be longer than 23 characters."), 0);
return 0;
} else {
for ($str,$agi,$vit,$int,$dex,$luk) {
if ($_ > 9 || $_ < 1) {
$interface->errorDialog(T("Stats must be comprised between 1 and 9."), 0);
return;
}
}
for ($str+$int, $agi+$luk, $vit+$dex) {
if ($_ != 10) {
$interface->errorDialog(T("The sums Str + Int, Agi + Luk and Vit + Dex must all be equal to 10."), 0);
return;
}
}
$messageSender->sendCharCreate($slot, $name,
$str, $agi, $vit, $int, $dex, $luk,
$hair_style, $hair_color);
return 1;
}
}
##
# void deal(Actor::Player player)
# Requires: defined($player)
# Ensures: exists $outgoingDeal{ID}
#
# Sends $player a deal request.
sub deal {
my $player = $_[0];
assert(defined $player) if DEBUG;
assert(UNIVERSAL::isa($player, 'Actor::Player')) if DEBUG;
$outgoingDeal{ID} = $player->{ID};
$messageSender->sendDeal($player->{ID});
}
##
# dealAddItem($item, $amount)
#
# Adds $amount of $item to the current deal.
sub dealAddItem {
my ($item, $amount) = @_;
$messageSender->sendDealAddItem($item->{index}, $amount);
$currentDeal{lastItemAmount} = $amount;
}
##
# drop(itemIndex, amount)
#
# Drops $amount of the item specified by $itemIndex. If $amount is not specified or too large, it defaults
# to the number of items you have.
sub drop {
my ($itemIndex, $amount) = @_;
my $item = $char->inventory->get($itemIndex);
if ($item) {
if (!$amount || $amount > $item->{amount}) {
$amount = $item->{amount};
}
$messageSender->sendDrop($item->{index}, $amount);
}
}
sub dumpData {
my $msg = shift;
my $silent = shift;
my $dump;
my $puncations = quotemeta '~!@#$%^&*()_+|"'';
$dump = "nn================================================n" .
getFormattedDate(int(time)) . "nn" .
length($msg) . " bytesnn";
for (my $i = 0; $i < length($msg); $i += 16) {
my $line;
my $data = substr($msg, $i, 16);
my $rawData = '';
for (my $j = 0; $j < length($data); $j++) {
my $char = substr($data, $j, 1);
if (($char =~ /W/ && $char =~ /S/ && !($char =~ /[$puncations]/))
|| ($char eq chr(10) || $char eq chr(13) || $char eq "t")) {
$rawData .= '.';
} else {
$rawData .= substr($data, $j, 1);
}
}
$line = getHex(substr($data, 0, 8));
$line .= ' ' . getHex(substr($data, 8)) if (length($data) > 8);
$line .= ' ' x (50 - length($line)) if (length($line) < 54);
$line .= " $rawDatan";
$line = sprintf("%3d> ", $i) . $line;
$dump .= $line;
}
open DUMP, ">> DUMP.txt";
print DUMP $dump;
close DUMP;
debug "$dumpn", "parseMsg", 2;
message T("Message Dumped into DUMP.txt!n"), undef, 1 unless ($silent);
}
sub getEmotionByCommand {
my $command = shift;
foreach (keys %emotions_lut) {
if (existsInList($emotions_lut{$_}{command}, $command)) {
return $_;
}
}
return undef;
}
sub getIDFromChat {
my $r_hash = shift;
my $msg_user = shift;
my $match_text = shift;
my $qm;
if ($match_text !~ /w+/ || $match_text eq "me" || $match_text eq "") {
foreach (keys %{$r_hash}) {
next if ($_ eq "");
if ($msg_user eq $r_hash->{$_}{name}) {
return $_;
}
}
} else {
foreach (keys %{$r_hash}) {
next if ($_ eq "");
$qm = quotemeta $match_text;
if ($r_hash->{$_}{name} =~ /$qm/i) {
return $_;
}
}
}
return undef;
}
##
# getNPCName(ID)
# ID: the packed ID of the NPC
# Returns: the name of the NPC
#
# Find the name of an NPC: could be NPC, monster, or unknown.
sub getNPCName {
my $ID = shift;
if ((my $npc = $npcsList->getByID($ID))) {
return $npc->name;
} elsif ((my $monster = $monstersList->getByID($ID))) {
return $monster->name;
} else {
return "Unknown #" . unpack("V1", $ID);
}
}
##
# getPlayerNameFromCache(player)
# player: an Actor::Player object.
# Returns: 1 on success, 0 if the player isn't in cache.
#
# Retrieve a player's name from cache and modify the player object.
sub getPlayerNameFromCache {
my ($player) = @_;
return if (!$config{cachePlayerNames});
my $entry = $playerNameCache{$player->{ID}};
return if (!$entry);
# Check whether the cache entry is too old or inconsistent.
# Default cache life time: 15 minutes.
if (timeOut($entry->{time}, $config{cachePlayerNames_duration}) || $player->{lv} != $entry->{lv} || $player->{jobID} != $entry->{jobID}) {
binRemove(@playerNameCacheIDs, $player->{ID});
delete $playerNameCache{$player->{ID}};
compactArray(@playerNameCacheIDs);
return 0;
}
$player->{name} = $entry->{name};
$player->{guild} = $entry->{guild} if ($entry->{guild});
return 1;
}
sub getPortalDestName {
my $ID = shift;
my %hash; # We only want unique names, so we use a hash
foreach (keys %{$portals_lut{$ID}{'dest'}}) {
my $key = $portals_lut{$ID}{'dest'}{$_}{'map'};
$hash{$key} = 1;
}
my @destinations = sort keys %hash;
return join('/', @destinations);
}
sub getResponse {
my $type = quotemeta shift;
my @keys;
foreach my $key (keys %responses) {
if ($key =~ /^$type_d+$/) {
push @keys, $key;
}
}
my $msg = $responses{$keys[int(rand(@keys))]};
$msg =~ s/%$(w+)/$responseVars{$1}/eig;
return $msg;
}
sub getSpellName {
my $spell = shift;
return $spells_lut{$spell} || "Unknown $spell";
}
##
# inInventory($itemName, $quantity = 1)
#
# Returns the item's index (can be 0!) if you have at least $quantity units of the item
# specified by $itemName in your inventory.
# Returns nothing otherwise.
sub inInventory {
my ($itemIndex, $quantity) = @_;
$quantity ||= 1;
my $item = $char->inventory->getByName($itemIndex);
return if !$item;
return unless $item->{amount} >= $quantity;
return $item->{invIndex};
}
##
# inventoryItemRemoved($invIndex, $amount)
#
# Removes $amount of $invIndex from $char->{inventory}.
# Also prints a message saying the item was removed (unless it is an arrow you
# fired).
sub inventoryItemRemoved {
my ($invIndex, $amount) = @_;
my $item = $char->inventory->get($invIndex);
if (!$char->{arrow} || ($item && $char->{arrow} != $item->{index})) {
# This item is not an equipped arrow
message TF("Inventory Item Removed: %s (%d) x %dn", $item->{name}, $invIndex, $amount), "inventory";
}
$item->{amount} -= $amount;
$char->inventory->remove($item) if ($item->{amount} <= 0);
$itemChange{$item->{name}} -= $amount;
}
# Resolve the name of a card
sub cardName {
my $cardID = shift;
# If card name is unknown, just return ?number
my $card = $items_lut{$cardID};
return "?$cardID" if !$card;
$card =~ s/ Card$//;
return $card;
}
# Resolve the name of a simple item
sub itemNameSimple {
my $ID = shift;
return 'Unknown' unless defined($ID);
return 'None' unless $ID;
return $items_lut{$ID} || "Unknown #$ID";
}
##
# itemName($item)
#
# Resolve the name of an item. $item should be a hash with these keys:
# nameID => integer index into %items_lut
# cards => 8-byte binary data as sent by server
# upgrade => integer upgrade level
sub itemName {
my $item = shift;
my $name = itemNameSimple($item->{nameID});
# Resolve item prefix/suffix (carded or forged)
my $prefix = "";
my $suffix = "";
my @cards;
my %cards;
for (my $i = 0; $i < 4; $i++) {
my $card = unpack("v1", substr($item->{cards}, $i*2, 2));
last unless $card;
push(@cards, $card);
($cards{$card} ||= 0) += 1;
}
if ($cards[0] == 254) {
# Alchemist-made potion
#
# Ignore the "cards" inside.
} elsif ($cards[0] == 65280) {
# Pet egg
# cards[0] == 65280
# substr($item->{cards}, 2, 4) = packed pet ID
# cards[3] == 1 if named, 0 if not named
} elsif ($cards[0] == 255) {
# Forged weapon
#
# Display e.g. "VVS Earth" or "Fire"
my $elementID = $cards[1] % 10;
my $elementName = $elements_lut{$elementID};
my $starCrumbs = ($cards[1] >> 8) / 5;
$prefix .= ('V'x$starCrumbs)."S " if $starCrumbs;
$prefix .= "$elementName " if ($elementName ne "");
} elsif (@cards) {
# Carded item
#
# List cards in alphabetical order.
# Stack identical cards.
# e.g. "Hydra*2,Mummy*2", "Hydra*3,Mummy"
$suffix = join(':', map {
cardName($_).($cards{$_} > 1 ? "*$cards{$_}" : '')
} sort { cardName($a) cmp cardName($b) } keys %cards);
}
my $numSlots = $itemSlotCount_lut{$item->{nameID}} if ($prefix eq "");
my $display = "";
$display .= "BROKEN " if $item->{broken};
$display .= "+$item->{upgrade} " if $item->{upgrade};
$display .= $prefix if $prefix;
$display .= $name;
$display .= " [$suffix]" if $suffix;
$display .= " [$numSlots]" if $numSlots;
return $display;
}
##
# storageGet(items, max)
# items: reference to an array of storage item hashes.
# max: the maximum amount to get, for each item, or 0 for unlimited.
#
# Get one or more items from storage.
#
# Example:
# # Get items $a and $b from storage.
# storageGet([$a, $b]);
# # Get items $a and $b from storage, but at most 30 of each item.
# storageGet([$a, $b], 30);
sub storageGet {
my $indices = shift;
my $max = shift;
if (@{$indices} == 1) {
my ($item) = @{$indices};
if (!defined($max) || $max > $item->{amount}) {
$max = $item->{amount};
}
$messageSender->sendStorageGet($item->{index}, $max);
} else {
my %args;
$args{items} = $indices;
$args{max} = $max;
$args{timeout} = 0.15;
AI::queue("storageGet", %args);
}
}
##
# headgearName(lookID)
#
# Resolves a lookID of a headgear into a human readable string.
#
# A lookID corresponds to a line number in tables/headgears.txt.
# The number on that line is the itemID for the headgear.
sub headgearName {
my ($lookID) = @_;
return "Nothing" if $lookID == 0;
my $itemID = $headgears_lut[$lookID];
if (!defined($itemID)) {
return "Unknown lookID $lookID";
}
return main::itemName({nameID => $itemID});
}
##
# void initUserSeed()
#
# Generate a unique seed for the current user and save it to
# a file, or load the seed from that file if it exists.
sub initUserSeed {
my $seedFile = "$Settings::logs_folder/seed.txt";
my $f;
if (-f $seedFile) {
if (open($f, "<", $seedFile)) {
binmode $f;
$userSeed = <$f>;
$userSeed =~ s/n.*//s;
close($f);
} else {
$userSeed = '0';
}
} else {
$userSeed = '';
for (0..10) {
$userSeed .= rand(2 ** 49);
}
if (open($f, ">", $seedFile)) {
binmode $f;
print $f $userSeed;
close($f);
}
}
}
sub itemLog_clear {
if (-f $Settings::item_log_file) { unlink($Settings::item_log_file); }
}
##
# look(bodydir, [headdir])
# bodydir: a number 0-7. See directions.txt.
# headdir: 0 = look directly, 1 = look right, 2 = look left
#
# Look in the given directions.
sub look {
my %args = (
look_body => shift,
look_head => shift
);
AI::queue("look", %args);
}
##
# lookAtPosition(pos, [headdir])
# pos: a reference to a coordinate hash.
# headdir: 0 = face directly, 1 = look right, 2 = look left
#
# Turn face and body direction to position %pos.
sub lookAtPosition {
my $pos2 = shift;
my $headdir = shift;
my %vec;
my $direction;
getVector(%vec, $pos2, $char->{pos_to});
$direction = int(sprintf("%.0f", (360 - vectorToDegree(%vec)) / 45)) % 8;
look($direction, $headdir);
}
##
# manualMove(dx, dy)
#
# Moves the character offset from its current position.
sub manualMove {
my ($dx, $dy) = @_;
# Stop following if necessary
if ($config{'follow'}) {
configModify('follow', 0);
AI::clear('follow');
}
# Stop moving if necessary
AI::clear(qw/move route mapRoute/);
main::ai_route($field{name}, $char->{pos_to}{x} + $dx, $char->{pos_to}{y} + $dy);
}
##
# meetingPosition(ID, attackMaxDistance)
# ID: ID of the character to meet.
# attackMaxDistance: attack distance based on attack method.
#
# Returns: the position where the character should go to meet a moving monster.
sub meetingPosition {
my ($target, $attackMaxDistance) = @_;
my $monsterSpeed = ($target->{walk_speed}) ? 1 / $target->{walk_speed} : 0;
my $timeMonsterMoves = time - $target->{time_move};
my %monsterPos;
$monsterPos{x} = $target->{pos}{x};
$monsterPos{y} = $target->{pos}{y};
my %monsterPosTo;
$monsterPosTo{x} = $target->{pos_to}{x};
$monsterPosTo{y} = $target->{pos_to}{y};
my %realMonsterPos = calcPosFromTime(%monsterPos, %monsterPosTo, $monsterSpeed, $timeMonsterMoves);
my $mySpeed = ($char->{walk_speed}) ? 1 / $char->{walk_speed} : 0;
my $timeCharMoves = time - $char->{time_move};
my %myPos;
$myPos{x} = $char->{pos}{x};
$myPos{y} = $char->{pos}{y};
my %myPosTo;
$myPosTo{x} = $char->{pos_to}{x};
$myPosTo{y} = $char->{pos_to}{y};
my %realMyPos = calcPosFromTime(%myPos, %myPosTo, $mySpeed, $timeCharMoves);
my $timeMonsterWalks;
my $timeCharWalks;
my %monsterStep;
my %charStep;
# There can not be zero step if monster moves
for (my $monsterStep = 1; $monsterStep <= countSteps(%realMonsterPos, %monsterPosTo); $monsterStep++) {
# Calculate the steps
%monsterStep = moveAlong(%realMonsterPos, %monsterPosTo, $monsterStep);
# Calculate time to walk for monster
$timeMonsterWalks = calcTime(%realMonsterPos, %monsterStep, $monsterSpeed);
# Character's route to monsterStep position
for (my $charStep = 0; $charStep <= countSteps(%realMyPos, %monsterStep); $charStep++) {
# Calculate the steps
%charStep = moveAlong(%realMyPos, %monsterStep, $charStep);
# Check whether the distance is fine
if (round(distance(%charStep, %monsterStep)) <= $attackMaxDistance) {
# Calculate time to walk for char
$timeCharWalks = calcTime(%realMyPos, %charStep, $mySpeed);
# Check whether character comes earlier or at the same time
if ($timeCharWalks <= $timeMonsterWalks) {
return %charStep;
}
}
}
}
# If the monster is too fast, move to its pos_to plus attackMaxDistance
for (my $charStep = 0; $charStep <= countSteps(%realMyPos, %monsterPosTo); $charStep++) {
# Calculate the steps
%charStep = moveAlong(%realMyPos, %monsterPosTo, $charStep);
# Check whether the distance is fine
if (round(distance(%charStep, %monsterPosTo)) <= $attackMaxDistance) {
last;
}
}
return %charStep;
}
sub objectAdded {
my ($type, $ID, $obj) = @_;
if ($type eq 'player' || $type eq 'slave') {
# Try to retrieve the player name from cache.
if (!getPlayerNameFromCache($obj)) {
push @unknownPlayers, $ID;
}
} elsif ($type eq 'npc') {
push @unknownNPCs, $ID;
}
if ($type eq 'monster') {
if (mon_control($obj->{name},$obj->{nameID})->{teleport_search}) {
$ai_v{temp}{searchMonsters}++;
}
}
Plugins::callHook('objectAdded', {
type => $type,
ID => $ID,
obj => $obj
});
}
sub objectRemoved {
my ($type, $ID, $obj) = @_;
if ($type eq 'monster') {
if (mon_control($obj->{name},$obj->{nameID})->{teleport_search}) {
$ai_v{temp}{searchMonsters}--;
}
}
Plugins::callHook('objectRemoved', {
type => $type,
ID => $ID
});
}
##
# items_control($name)
#
# Returns the items_control.txt settings for item name $name.
# If $name has no specific settings, use 'all'.
sub items_control {
my ($name) = @_;
return $items_control{lc($name)} || $items_control{all} || {};
}
##
# mon_control($name)
#
# Returns the mon_control.txt settings for monster name $name.
# If $name has no specific settings, use 'all'.
sub mon_control {
my $name = shift;
my $nameID = shift;
return $mon_control{lc($name)} || $mon_control{$nameID} || $mon_control{all} || { attack_auto => 1 };
}
##
# pickupitems($name)
#
# Returns the pickupitems.txt settings for item name $name.
# If $name has no specific settings, use 'all'.
sub pickupitems {
my ($name) = @_;
return ($pickupitems{lc($name)} ne '') ? $pickupitems{lc($name)} : $pickupitems{all};
}
sub positionNearPlayer {
my $r_hash = shift;
my $dist = shift;
my $players = $playersList->getItems();
foreach my $player (@{$players}) {
my $ID = $player->{ID};
next if ($char->{party} && $char->{party}{users} &&
$char->{party}{users}{$ID});
next if (defined($player->{name}) && existsInList($config{tankersList}, $player->{name}));
return 1 if (distance($r_hash, $player->{pos_to}) <= $dist);
}
return 0;
}
sub positionNearPortal {
my $r_hash = shift;
my $dist = shift;
my $portals = $portalsList->getItems();
foreach my $portal (@{$portals}) {
return 1 if (distance($r_hash, $portal->{pos}) <= $dist);
}
return 0;
}
##
# printItemDesc(itemID)
#
# Print the description for $itemID.
sub printItemDesc {
my $itemID = shift;
my $itemName = itemNameSimple($itemID);
my $description = $itemsDesc_lut{$itemID} || T("Error: No description available.n");
message TF("===============Item Description===============nItem: %snn", $itemName), "info";
message($description, "info");
message("==============================================n", "info");
}
sub processNameRequestQueue {
my ($queue, $actorLists, $foo) = @_;
while (@{$queue}) {
my $ID = $queue->[0];
my $actor;
foreach my $actorList (@$actorLists) {
last if $actor = $actorList->getByID($ID);
}
# Some private servers ban you if you request info for an object with
# GM Perfect Hide status
if (!$actor || defined($actor->{name}) || $actor->{statuses}{"GM Perfect Hide"}) {
shift @{$queue};
next;
}
# Remove actors with a distance greater than clientSight. Some private servers (notably Freya) use
# a technique where they send actor_exists packets with ridiculous distances in order to automatically
# ban bots. By removingthose actors, we eliminate that possibility and emulate the client more closely.
if (defined $actor->{pos_to} && (my $block_dist = blockDistance($char->{pos_to}, $actor->{pos_to})) >= ($config{clientSight} || 16)) {
debug "Removed actor at $actor->{pos_to}{x} $actor->{pos_to}{y} (distance: $block_dist)n";
shift @{$queue};
next;
}
$messageSender->sendGetPlayerInfo($ID);
$actor = shift @{$queue};
push @{$queue}, $actor if ($actor);
last;
}
}
sub quit {
$quit = 1;
message T("Exiting...n"), "system";
}
sub relog {
my $timeout = (shift || 5);
my $silent = shift;
$net->setState(1) if ($net);
undef $conState_tries;
$timeout_ex{'master'}{'time'} = time;
$timeout_ex{'master'}{'timeout'} = $timeout;
$net->serverDisconnect() if ($net);
message TF("Relogging in %d seconds...n", $timeout), "connection" unless $silent;
}
##
# sendMessage(String type, String msg, String user)
# type: Specifies what kind of message this is. "c" for public chat, "g" for guild chat,
# "p" for party chat, "pm" for private message, "k" for messages that only the RO
# client will see (in X-Kore mode.)
# msg: The message to send.
# user:
#
# Send a chat message to a user.
sub sendMessage {
my ($sender, $type, $msg, $user) = @_;
my ($j, @msgs, $oldmsg, $amount, $space);
@msgs = split /\n/, $msg;
for ($j = 0; $j < @msgs; $j++) {
my (@msg, $i);
@msg = split / /, $msgs[$j];
undef $msg;
for ($i = 0; $i < @msg; $i++) {
if (!length($msg[$i])) {
$msg[$i] = " ";
$space = 1;
}
if (length($msg[$i]) > $config{'message_length_max'}) {
while (length($msg[$i]) >= $config{'message_length_max'}) {
$oldmsg = $msg;
if (length($msg)) {
$amount = $config{'message_length_max'};
if ($amount - length($msg) > 0) {
$amount = $config{'message_length_max'} - 1;
$msg .= " " . substr($msg[$i], 0, $amount - length($msg));
}
} else {
$amount = $config{'message_length_max'};
$msg .= substr($msg[$i], 0, $amount);
}
if ($type eq "c") {
$sender->sendChat($msg);
} elsif ($type eq "g") {
$sender->sendGuildChat($msg);
} elsif ($type eq "p") {
$sender->sendPartyChat($msg);
} elsif ($type eq "pm") {
$sender->sendPrivateMsg($user, $msg);
%lastpm = (
msg => $msg,
user => $user
);
push @lastpm, {%lastpm};
} elsif ($type eq "k") {
$sender->injectMessage($msg);
}
$msg[$i] = substr($msg[$i], $amount - length($oldmsg), length($msg[$i]) - $amount - length($oldmsg));
undef $msg;
}
}
if (length($msg[$i]) && length($msg) + length($msg[$i]) <= $config{'message_length_max'}) {
if (length($msg)) {
if (!$space) {
$msg .= " " . $msg[$i];
} else {
$space = 0;
$msg .= $msg[$i];
}
} else {
$msg .= $msg[$i];
}
} else {
if ($type eq "c") {
$sender->sendChat($msg);
} elsif ($type eq "g") {
$sender->sendGuildChat($msg);
} elsif ($type eq "p") {
$sender->sendPartyChat($msg);
} elsif ($type eq "pm") {
$sender->sendPrivateMsg($user, $msg);
%lastpm = (
msg => $msg,
user => $user
);
push @lastpm, {%lastpm};
} elsif ($type eq "k") {
$sender->injectMessage($msg);
}
$msg = $msg[$i];
}
if (length($msg) && $i == @msg - 1) {
if ($type eq "c") {
$sender->sendChat($msg);
} elsif ($type eq "g") {
$sender->sendGuildChat($msg);
} elsif ($type eq "p") {
$sender->sendPartyChat($msg);
} elsif ($type eq "pm") {
$sender->sendPrivateMsg($user, $msg);
%lastpm = (
msg => $msg,
user => $user
);
push @lastpm, {%lastpm};
} elsif ($type eq "k") {
$sender->injectMessage($msg);
}
}
}
}
}
# Keep track of when we last cast a skill
sub setSkillUseTimer {
my ($skillID, $targetID, $wait) = @_;
my $skill = new Skill(idn => $skillID);
my $handle = $skill->getHandle();
$char->{skills}{$handle}{time_used} = time;
delete $char->{time_cast};
delete $char->{cast_cancelled};
$char->{last_skill_time} = time;
$char->{last_skill_used} = $skillID;
$char->{last_skill_target} = $targetID;
# increment monsterSkill maxUses counter
if (defined $targetID) {
my $actor = Actor::get($targetID);
$actor->{skillUses}{$skill->getHandle()}++;
}
# Set encore skill if applicable
$char->{encoreSkill} = $skill if $targetID eq $accountID && $skillsEncore{$skill->getHandle()};
}
sub setPartySkillTimer {
my ($skillID, $targetID) = @_;
my $skill = new Skill(idn => $skillID);
my $handle = $skill->getHandle();
# set partySkill target_time
my $i = $targetTimeout{$targetID}{$handle};
$ai_v{"partySkill_${i}_target_time"}{$targetID} = time if $i ne "";
}
##
# boolean setStatus(Actor actor, param1, param2, param3)
# param1: the state information of the actor.
# param2: the ailment information of the actor.
# param3: the "look" information of the actor.
# Returns: Whether the actor should be removed from the actor list.
#
# Sets the state, ailment, and "look" statuses of the actor.
# Does not include skillsstatus.txt items.
sub setStatus {
my ($actor, $param1, $param2, $param3) = @_;
my $verbosity = $actor->{ID} eq $accountID ? 1 : 2;
my $are = $actor->verb('are', 'is');
my $have = $actor->verb('have', 'has');