· 10 years ago · Apr 15, 2016, 11:12 PM
1#########################################################################
2# OpenKore - Miscellaneous functions
3#
4# This software is open source, licensed under the GNU General Public
5# License, version 2.
6# Basically, this means that you're allowed to modify and distribute
7# this software. However, if you distribute modified versions, you MUST
8# also distribute the source code.
9# See http://www.gnu.org/licenses/gpl.html for the full license.
10#
11# $Revision: 7759 $
12# $Id: Misc.pm 7759 2011-06-01 04:53:20Z farrainbow $fm
13#
14#########################################################################
15##
16# MODULE DESCRIPTION: Miscellaneous functions
17#
18# This module contains functions that do not belong in any other modules.
19# The difference between Misc.pm and Utils.pm is that Misc.pm can have
20# dependencies on other Kore modules.
21
22package Misc;
23
24use strict;
25use Exporter;
26use Carp::Assert;
27use Data::Dumper;
28use Compress::Zlib;
29use base qw(Exporter);
30use encoding 'utf8';
31
32use Globals;
33use Log qw(message warning error debug);
34use Plugins;
35use FileParsers;
36use Settings;
37use Utils;
38use Utils::Assert;
39use Skill;
40use Field;
41use Network;
42use Network::Send ();
43use AI;
44use Actor;
45use Actor::You;
46use Actor::Player;
47use Actor::Monster;
48use Actor::Party;
49use Actor::NPC;
50use Actor::Portal;
51use Actor::Pet;
52use Actor::Slave;
53use Actor::Unknown;
54use Time::HiRes qw(time usleep);
55use Translation;
56use Utils::Exceptions;
57
58our @EXPORT = (
59 # Config modifiers
60 qw/auth
61 configModify
62 bulkConfigModify
63 setTimeout
64 saveConfigFile/,
65
66 # Debugging
67 qw/debug_showSpots
68 visualDump/,
69
70 # Field math
71 qw/calcRectArea
72 calcRectArea2
73 checkLineSnipable
74 checkLineWalkable
75 checkWallLength
76 closestWalkableSpot
77 objectInsideSpell
78 objectIsMovingTowards
79 objectIsMovingTowardsPlayer/,
80
81 # Inventory management
82 qw/inInventory
83 inventoryItemRemoved
84 storageGet
85 cardName
86 itemName
87 itemNameSimple
88 buyingstoreitemdelete/,
89
90 # File Parsing and Writing
91 qw/chatLog
92 shopLog
93 monsterLog/,
94
95 # Logging
96 qw/itemLog/,
97
98 # OS specific
99 qw/launchURL/,
100
101 # Misc
102 qw/
103 actorAdded
104 actorRemoved
105 actorListClearing
106 avoidGM_talk
107 avoidList_talk
108 avoidList_ID
109 calcStat
110 center
111 charSelectScreen
112 chatLog_clear
113 checkAllowedMap
114 checkFollowMode
115 checkMonsterCleanness
116 createCharacter
117 deal
118 dealAddItem
119 drop
120 dumpData
121 getEmotionByCommand
122 getIDFromChat
123 getNPCName
124 getPlayerNameFromCache
125 getPortalDestName
126 getResponse
127 getSpellName
128 headgearName
129 initUserSeed
130 itemLog_clear
131 look
132 lookAtPosition
133 manualMove
134 meetingPosition
135 objectAdded
136 objectRemoved
137 items_control
138 pickupitems
139 mon_control
140 monsterName
141 positionNearPlayer
142 positionNearPortal
143 printItemDesc
144 processNameRequestQueue
145 quit
146 relog
147 sendMessage
148 setSkillUseTimer
149 setPartySkillTimer
150 setStatus
151 countCastOn
152 stripLanguageCode
153 switchConfigFile
154 updateDamageTables
155 updatePlayerNameCache
156 useTeleport
157 top10Listing
158 whenGroundStatus
159 writeStorageLog
160 getBestTarget
161 isSafe
162 isSafeActorQuery/,
163
164 # Actor's Actions Text
165 qw/attack_string
166 skillCast_string
167 skillUse_string
168 skillUseLocation_string
169 skillUseNoDamage_string
170 status_string/,
171
172 # AI Math
173 qw/lineIntersection
174 percent_hp
175 percent_sp
176 percent_weight/,
177
178 # Misc Functions
179 qw/avoidGM_near
180 avoidList_near
181 compilePortals
182 compilePortals_check
183 portalExists
184 portalExists2
185 redirectXKoreMessages
186 monKilled
187 getActorName
188 getActorNames
189 findPartyUserID
190 getNPCInfo
191 skillName
192 checkSelfCondition
193 checkPlayerCondition
194 checkMonsterCondition
195 findCartItemInit
196 findCartItem
197 makeShop
198 openShop
199 closeShop
200 inLockMap
201 parseReload/
202 );
203
204
205# use SelfLoader; 1;
206# __DATA__
207
208
209
210sub _checkActorHash($$$$) {
211 my ($name, $hash, $type, $hashName) = @_;
212 foreach my $actor (values %{$hash}) {
213 if (!UNIVERSAL::isa($actor, $type)) {
214 die "$name\nUnblessed item in $hashName list:\n" .
215 Dumper($hash);
216 }
217 }
218}
219
220# Checks whether the internal state of some variables are correct.
221sub checkValidity {
222 return if (!DEBUG || $ENV{OPENKORE_NO_CHECKVALIDITY});
223 my ($name) = @_;
224 $name = "Validity check:" if (!defined $name);
225
226 assertClass($char, 'Actor::You') if ($net && $net->getState() == Network::IN_GAME
227 && $net->isa('Network::XKore'));
228 assertClass($char, 'Actor::You') if ($char);
229 return;
230
231 _checkActorHash($name, \%items, 'Actor::Item', 'item');
232 _checkActorHash($name, \%monsters, 'Actor::Monster', 'monster');
233 _checkActorHash($name, \%players, 'Actor::Player', 'player');
234 _checkActorHash($name, \%pets, 'Actor::Pet', 'pet');
235 _checkActorHash($name, \%npcs, 'Actor::NPC', 'NPC');
236 _checkActorHash($name, \%portals, 'Actor::Portal', 'portals');
237}
238
239
240#######################################
241#######################################
242### CATEGORY: Configuration modifiers
243#######################################
244#######################################
245
246sub auth {
247 my $user = shift;
248 my $flag = shift;
249 if ($flag) {
250 message TF("Authorized user '%s' for admin\n", $user), "success";
251 } else {
252 message TF("Revoked admin privilages for user '%s'\n", $user), "success";
253 }
254 $overallAuth{$user} = $flag;
255 writeDataFile(Settings::getControlFilename("overallAuth.txt"), \%overallAuth);
256}
257
258##
259# void configModify(String key, String value, ...)
260# key: a key name.
261# value: the new value.
262#
263# Changes the value of the configuration option $key to $value.
264# Both %config and config.txt will be updated.
265#
266# You may also call configModify() with additional optional options:
267# `l
268# - autoCreate (boolean): Whether the configuration option $key
269# should be created if it doesn't already exist.
270# The default is true.
271# - silent (boolean): By default, output will be printed, notifying the user
272# that a config option has been changed. Setting this to
273# true will surpress that output.
274# `l`
275sub configModify {
276 my $key = shift;
277 my $val = shift;
278 my %args;
279
280 if (@_ == 1) {
281 $args{silent} = $_[0];
282 } else {
283 %args = @_;
284 }
285 $args{autoCreate} = 1 if (!exists $args{autoCreate});
286
287 Plugins::callHook('configModify', {
288 key => $key,
289 val => $val,
290 additionalOptions => \%args
291 });
292
293 if (!$args{silent} && $key !~ /password/i) {
294 my $oldval = $config{$key};
295 if (!defined $oldval) {
296 $oldval = "not set";
297 }
298
299 if (!defined $val) {
300 message TF("Config '%s' unset (was %s)\n", $key, $oldval), "info";
301 } else {
302 message TF("Config '%s' set to %s (was %s)\n", $key, $val, $oldval), "info";
303 }
304 }
305 if ($args{autoCreate} && !exists $config{$key}) {
306 my $f;
307 if (open($f, ">>", Settings::getConfigFilename())) {
308 print $f "$key\n";
309 close($f);
310 }
311 }
312 $config{$key} = $val;
313 saveConfigFile();
314}
315
316##
317# bulkConfigModify (r_hash, [silent])
318# r_hash: key => value to change
319# silent: if set to 1, do not print a message to the console.
320#
321# like configModify but for more than one value at the same time.
322sub bulkConfigModify {
323 my $r_hash = shift;
324 my $silent = shift;
325 my $oldval;
326
327 foreach my $key (keys %{$r_hash}) {
328 Plugins::callHook('configModify', {
329 key => $key,
330 val => $r_hash->{$key},
331 silent => $silent
332 });
333
334 $oldval = $config{$key};
335
336 $config{$key} = $r_hash->{$key};
337
338 if ($key =~ /password/i) {
339 message TF("Config '%s' set to %s (was *not-displayed*)\n", $key, $r_hash->{$key}), "info" unless ($silent);
340 } else {
341 message TF("Config '%s' set to %s (was %s)\n", $key, $r_hash->{$key}, $oldval), "info" unless ($silent);
342 }
343 }
344 saveConfigFile();
345}
346
347##
348# saveConfigFile()
349#
350# Writes %config to config.txt.
351sub saveConfigFile {
352 writeDataFileIntact(Settings::getConfigFilename(), \%config);
353}
354
355sub setTimeout {
356 my $timeout = shift;
357 my $time = shift;
358 message TF("Timeout '%s' set to %s (was %s)\n", $timeout, $time, $timeout{$timeout}{timeout}), "info";
359 $timeout{$timeout}{'timeout'} = $time;
360 writeDataFileIntact2(Settings::getControlFilename("timeouts.txt"), \%timeout);
361}
362
363
364#######################################
365#######################################
366### Category: Debugging
367#######################################
368#######################################
369
370our %debug_showSpots_list;
371
372sub debug_showSpots {
373 return unless $net->clientAlive();
374 my $ID = shift;
375 my $spots = shift;
376 my $special = shift;
377
378 if ($debug_showSpots_list{$ID}) {
379 foreach (@{$debug_showSpots_list{$ID}}) {
380 my $msg = pack("C*", 0x20, 0x01) . pack("V", $_);
381 $net->clientSend($msg);
382 }
383 }
384
385 my $i = 1554;
386 $debug_showSpots_list{$ID} = [];
387 foreach (@{$spots}) {
388 next if !defined $_;
389 my $msg = pack("C*", 0x1F, 0x01)
390 . pack("V*", $i, 1550)
391 . pack("v*", $_->{x}, $_->{y})
392 . pack("C*", 0x93, 0);
393 $net->clientSend($msg);
394 $net->clientSend($msg);
395 push @{$debug_showSpots_list{$ID}}, $i;
396 $i++;
397 }
398
399 if ($special) {
400 my $msg = pack("C*", 0x1F, 0x01)
401 . pack("V*", 1553, 1550)
402 . pack("v*", $special->{x}, $special->{y})
403 . pack("C*", 0x83, 0);
404 $net->clientSend($msg);
405 $net->clientSend($msg);
406 push @{$debug_showSpots_list{$ID}}, 1553;
407 }
408}
409
410##
411# visualDump(data [, label])
412#
413# Show the bytes in $data on screen as hexadecimal.
414# Displays the label if provided.
415sub visualDump {
416 my ($msg, $label) = @_;
417 my $dump;
418 my $puncations = quotemeta '~!@#$%^&*()_-+=|\"\'';
419 no encoding 'utf8';
420 use bytes;
421
422 $dump = "================================================\n";
423 if (defined $label) {
424 $dump .= sprintf("%-15s [%d bytes] %s\n", $label, length($msg), getFormattedDate(int(time)));
425 } else {
426 $dump .= sprintf("%d bytes %s\n", length($msg), getFormattedDate(int(time)));
427 }
428
429 for (my $i = 0; $i < length($msg); $i += 16) {
430 my $line;
431 my $data = substr($msg, $i, 16);
432 my $rawData = '';
433
434 for (my $j = 0; $j < length($data); $j++) {
435 my $char = substr($data, $j, 1);
436 if (ord($char) < 32 || ord($char) > 126) {
437 $rawData .= '.';
438 } else {
439 $rawData .= substr($data, $j, 1);
440 }
441 }
442
443 $line = getHex(substr($data, 0, 8));
444 $line .= ' ' . getHex(substr($data, 8)) if (length($data) > 8);
445
446 $line .= ' ' x (50 - length($line)) if (length($line) < 54);
447 $line .= " $rawData\n";
448 $line = sprintf("%3d> ", $i) . $line;
449 $dump .= $line;
450 }
451 message $dump;
452}
453
454
455#######################################
456#######################################
457### CATEGORY: Field math
458#######################################
459#######################################
460
461##
462# calcRectArea($x, $y, $radius)
463# Returns: an array with position hashes. Each has contains an x and a y key.
464#
465# Creates a rectangle with center ($x,$y) and radius $radius,
466# and returns a list of positions of the border of the rectangle.
467sub calcRectArea {
468 my ($x, $y, $radius) = @_;
469 my (%topLeft, %topRight, %bottomLeft, %bottomRight);
470
471 sub capX {
472 return 0 if ($_[0] < 0);
473 return $field->width - 1 if ($_[0] >= $field->width);
474 return int $_[0];
475 }
476 sub capY {
477 return 0 if ($_[0] < 0);
478 return $field->height - 1 if ($_[0] >= $field->height);
479 return int $_[0];
480 }
481
482 # Get the avoid area as a rectangle
483 $topLeft{x} = capX($x - $radius);
484 $topLeft{y} = capY($y + $radius);
485 $topRight{x} = capX($x + $radius);
486 $topRight{y} = capY($y + $radius);
487 $bottomLeft{x} = capX($x - $radius);
488 $bottomLeft{y} = capY($y - $radius);
489 $bottomRight{x} = capX($x + $radius);
490 $bottomRight{y} = capY($y - $radius);
491
492 # Walk through the border of the rectangle
493 # Record the blocks that are walkable
494 my @walkableBlocks;
495 for (my $x = $topLeft{x}; $x <= $topRight{x}; $x++) {
496 if ($field->isWalkable($x, $topLeft{y})) {
497 push @walkableBlocks, {x => $x, y => $topLeft{y}};
498 }
499 }
500 for (my $x = $bottomLeft{x}; $x <= $bottomRight{x}; $x++) {
501 if ($field->isWalkable($x, $bottomLeft{y})) {
502 push @walkableBlocks, {x => $x, y => $bottomLeft{y}};
503 }
504 }
505 for (my $y = $bottomLeft{y} + 1; $y < $topLeft{y}; $y++) {
506 if ($field->isWalkable($topLeft{x}, $y)) {
507 push @walkableBlocks, {x => $topLeft{x}, y => $y};
508 }
509 }
510 for (my $y = $bottomRight{y} + 1; $y < $topRight{y}; $y++) {
511 if ($field->isWalkable($topRight{x}, $y)) {
512 push @walkableBlocks, {x => $topRight{x}, y => $y};
513 }
514 }
515
516 return @walkableBlocks;
517}
518
519##
520# calcRectArea2($x, $y, $radius, $minRange)
521# Returns: an array with position hashes. Each has contains an x and a y key.
522#
523# Creates a rectangle with center ($x,$y) and radius $radius,
524# and returns a list of positions inside the rectangle that are
525# not closer than $minRange to the center.
526sub calcRectArea2 {
527 my ($cx, $cy, $r, $min) = @_;
528
529 my @rectangle;
530 for (my $x = $cx - $r; $x <= $cx + $r; $x++) {
531 for (my $y = $cy - $r; $y <= $cy + $r; $y++) {
532 next if distance({x => $cx, y => $cy}, {x => $x, y => $y}) < $min;
533 push(@rectangle, {x => $x, y => $y});
534 }
535 }
536 return @rectangle;
537}
538
539##
540# checkLineSnipable(from, to)
541# from, to: references to position hashes.
542#
543# Check whether you can snipe a target standing at $to,
544# from the position $from, without being blocked by any
545# obstacles.
546# TODO: move to Field?
547sub checkLineSnipable {
548 return 0 if (!$field);
549 my $from = shift;
550 my $to = shift;
551
552 # Simulate tracing a line to the location (modified Bresenham's algorithm)
553 my ($X0, $Y0, $X1, $Y1) = ($from->{x}, $from->{y}, $to->{x}, $to->{y});
554
555 my $steep;
556 my $posX = 1;
557 my $posY = 1;
558 if ($X1 - $X0 < 0) {
559 $posX = -1;
560 }
561 if ($Y1 - $Y0 < 0) {
562 $posY = -1;
563 }
564 if (abs($Y0 - $Y1) < abs($X0 - $X1)) {
565 $steep = 0;
566 } else {
567 $steep = 1;
568 }
569 if ($steep == 1) {
570 my $Yt = $Y0;
571 $Y0 = $X0;
572 $X0 = $Yt;
573
574 $Yt = $Y1;
575 $Y1 = $X1;
576 $X1 = $Yt;
577 }
578 if ($X0 > $X1) {
579 my $Xt = $X0;
580 $X0 = $X1;
581 $X1 = $Xt;
582
583 my $Yt = $Y0;
584 $Y0 = $Y1;
585 $Y1 = $Yt;
586 }
587 my $dX = $X1 - $X0;
588 my $dY = abs($Y1 - $Y0);
589 my $E = 0;
590 my $dE;
591 if ($dX) {
592 $dE = $dY / $dX;
593 } else {
594 # Delta X is 0, it only occures when $from is equal to $to
595 return 1;
596 }
597 my $stepY;
598 if ($Y0 < $Y1) {
599 $stepY = 1;
600 } else {
601 $stepY = -1;
602 }
603 my $Y = $Y0;
604 my $Erate = 0.99;
605 if (($posY == -1 && $posX == 1) || ($posY == 1 && $posX == -1)) {
606 $Erate = 0.01;
607 }
608 for (my $X=$X0;$X<=$X1;$X++) {
609 $E += $dE;
610 if ($steep == 1) {
611 return 0 if (!$field->isSnipable($Y, $X));
612 } else {
613 return 0 if (!$field->isSnipable($X, $Y));
614 }
615 if ($E >= $Erate) {
616 $Y += $stepY;
617 $E -= 1;
618 }
619 }
620 return 1;
621}
622
623##
624# checkLineWalkable(from, to, [min_obstacle_size = 5])
625# from, to: references to position hashes.
626#
627# Check whether you can walk from $from to $to in an (almost)
628# straight line, without obstacles that are too large.
629# Obstacles are considered too large, if they are at least
630# the size of a rectangle with "radius" $min_obstacle_size.
631# TODO: move to Field?
632sub checkLineWalkable {
633 return 0 if (!$field);
634 my $from = shift;
635 my $to = shift;
636 my $min_obstacle_size = shift;
637 $min_obstacle_size = 5 if (!defined $min_obstacle_size);
638
639 my $dist = round(distance($from, $to));
640 my %vec;
641
642 getVector(\%vec, $to, $from);
643 # Simulate walking from $from to $to
644 for (my $i = 1; $i < $dist; $i++) {
645 my %p;
646 moveAlongVector(\%p, $from, \%vec, $i);
647 $p{x} = int $p{x};
648 $p{y} = int $p{y};
649
650 if ( !$field->isWalkable($p{x}, $p{y}) ) {
651 # The current spot is not walkable. Check whether
652 # this the obstacle is small enough.
653 if (checkWallLength(\%p, -1, 0, $min_obstacle_size) || checkWallLength(\%p, 1, 0, $min_obstacle_size)
654 || checkWallLength(\%p, 0, -1, $min_obstacle_size) || checkWallLength(\%p, 0, 1, $min_obstacle_size)
655 || checkWallLength(\%p, -1, -1, $min_obstacle_size) || checkWallLength(\%p, 1, 1, $min_obstacle_size)
656 || checkWallLength(\%p, 1, -1, $min_obstacle_size) || checkWallLength(\%p, -1, 1, $min_obstacle_size)) {
657 return 0;
658 }
659 }
660 }
661 return 1;
662}
663
664sub checkWallLength {
665 my $pos = shift;
666 my $dx = shift;
667 my $dy = shift;
668 my $length = shift;
669
670 my $x = $pos->{x};
671 my $y = $pos->{y};
672 my $len = 0;
673 do {
674 last if ($x < 0 || $x >= $field->width || $y < 0 || $y >= $field->height);
675 $x += $dx;
676 $y += $dy;
677 $len++;
678 } while (!$field->isWalkable($x, $y) && $len < $length);
679 return $len >= $length;
680}
681
682##
683# closestWalkableSpot(r_field, pos)
684# r_field: a reference to a field hash.
685# pos: reference to a position hash (which contains 'x' and 'y' keys).
686# Returns: 1 if %pos has been modified, 0 of not.
687#
688# If the position specified in $pos is walkable, this function will do nothing.
689# If it's not walkable, this function will find the closest position that is walkable (up to N blocks away),
690# and modify the x and y values in $pos.
691# TODO: move to Field?
692{
693 my @spots;
694 sub closestWalkableSpot {
695 my $field = shift;
696 my $pos = shift;
697
698 unless (@spots) {
699 @spots = ([0, 0]);
700 for my $dist (1 .. 7) {
701 push @spots, map { [$_, $dist-$_], [$dist-$_, -$_], [-$_, $_-$dist], [$_-$dist, $_] } 0 .. $dist-1;
702 }
703 }
704
705 foreach my $z (@spots) {
706 next if !$field->isWalkable($pos->{x} + $z->[0], $pos->{y} + $z->[1]);
707 $pos->{x} += $z->[0];
708 $pos->{y} += $z->[1];
709 return 1;
710 }
711 return 0;
712 }
713}
714
715##
716# objectInsideSpell(object, [ignore_party_members = 1])
717# object: reference to a player or monster hash.
718#
719# Checks whether an object is inside someone else's spell area.
720# (Traps are also "area spells").
721sub objectInsideSpell {
722 my $object = shift;
723 my $ignore_party_members = shift;
724 $ignore_party_members = 1 if (!defined $ignore_party_members);
725
726 my ($x, $y) = ($object->{pos_to}{x}, $object->{pos_to}{y});
727 foreach (@spellsID) {
728 my $spell = $spells{$_};
729 if ((!$ignore_party_members || !$char->{party} || !$char->{party}{users}{$spell->{sourceID}})
730 && $spell->{sourceID} ne $accountID
731 && $spell->{pos}{x} == $x && $spell->{pos}{y} == $y) {
732 return 1;
733 }
734 }
735 return 0;
736}
737
738##
739# objectIsMovingTowards(object1, object2, [max_variance])
740#
741# Check whether $object1 is moving towards $object2.
742sub objectIsMovingTowards {
743 my $obj = shift;
744 my $obj2 = shift;
745 my $max_variance = (shift || 15);
746
747 if (!timeOut($obj->{time_move}, $obj->{time_move_calc})) {
748 # $obj is still moving
749 my %vec;
750 getVector(\%vec, $obj->{pos_to}, $obj->{pos});
751 return checkMovementDirection($obj->{pos}, \%vec, $obj2->{pos_to}, $max_variance);
752 }
753 return 0;
754}
755
756##
757# objectIsMovingTowardsPlayer(object, [ignore_party_members = 1])
758#
759# Check whether an object is moving towards a player.
760sub objectIsMovingTowardsPlayer {
761 my $obj = shift;
762 my $ignore_party_members = shift;
763 $ignore_party_members = 1 if (!defined $ignore_party_members);
764
765 if (!timeOut($obj->{time_move}, $obj->{time_move_calc}) && @playersID) {
766 # Monster is still moving, and there are players on screen
767 my %vec;
768 getVector(\%vec, $obj->{pos_to}, $obj->{pos});
769
770 my $players = $playersList->getItems();
771 foreach my $player (@{$players}) {
772 my $ID = $player->{ID};
773 next if (
774 ($ignore_party_members && $char->{party} && $char->{party}{users}{$ID})
775 || (defined($player->{name}) && existsInList($config{tankersList}, $player->{name}))
776 || $player->statusActive('EFFECTSTATE_SPECIALHIDING'));
777 if (checkMovementDirection($obj->{pos}, \%vec, $player->{pos}, 15)) {
778 return 1;
779 }
780 }
781 }
782 return 0;
783}
784
785
786#########################################
787#########################################
788### CATEGORY: Logging
789#########################################
790#########################################
791
792# TODO: merge?
793sub itemLog {
794 my $crud = shift;
795 return if (!$config{'itemHistory'});
796 open ITEMLOG, ">>:utf8", $Settings::item_log_file;
797 print ITEMLOG "[".getFormattedDate(int(time))."] $crud";
798 close ITEMLOG;
799}
800
801sub chatLog {
802 my $type = shift;
803 my $message = shift;
804 open CHAT, ">>:utf8", $Settings::chat_log_file;
805 print CHAT "[".getFormattedDate(int(time))."][".uc($type)."] $message";
806 close CHAT;
807}
808
809sub shopLog {
810 my $crud = shift;
811 open SHOPLOG, ">>:utf8", $Settings::shop_log_file;
812 print SHOPLOG "[".getFormattedDate(int(time))."] $crud";
813 close SHOPLOG;
814}
815
816sub monsterLog {
817 my $crud = shift;
818 return if (!$config{'monsterLog'});
819 open MONLOG, ">>:utf8", $Settings::monster_log_file;
820 print MONLOG "[".getFormattedDate(int(time))."] $crud\n";
821 close MONLOG;
822}
823
824
825#########################################
826#########################################
827### CATEGORY: Operating system specific
828#########################################
829#########################################
830
831
832##
833# launchURL(url)
834#
835# Open $url in the operating system's preferred web browser.
836sub launchURL {
837 my $url = shift;
838
839 if ($^O eq 'MSWin32') {
840 require Utils::Win32;
841 Utils::Win32::ShellExecute(0, undef, $url);
842
843 } else {
844 my $mod = 'use POSIX;';
845 eval $mod;
846
847 # This is a script I wrote for the autopackage project
848 # It autodetects the current desktop environment
849 my $detectionScript = <<EOF;
850 function detectDesktop() {
851 if [[ "\$DISPLAY" = "" ]]; then
852 return 1
853 fi
854
855 local LC_ALL=C
856 local clients
857 if ! clients=`xlsclients`; then
858 return 1
859 fi
860
861 if echo "\$clients" | grep -qE '(gnome-panel|nautilus|metacity)'; then
862 echo gnome
863 elif echo "\$clients" | grep -qE '(kicker|slicker|karamba|kwin)'; then
864 echo kde
865 else
866 echo other
867 fi
868 return 0
869 }
870 detectDesktop
871EOF
872
873 my ($r, $w, $desktop);
874
875 my $pid = IPC::Open2::open2($r, $w, '/bin/bash');
876 print $w $detectionScript;
877 close $w;
878 $desktop = <$r>;
879 $desktop =~ s/\n//;
880 close $r;
881 waitpid($pid, 0);
882
883 sub checkCommand {
884 foreach (split(/:/, $ENV{PATH})) {
885 return 1 if (-x "$_/$_[0]");
886 }
887 return 0;
888 }
889
890 if (checkCommand('xdg-open')) {
891 launchApp(1, 'xdg-open', $url);
892
893 } elsif ($desktop eq "gnome" && checkCommand('gnome-open')) {
894 launchApp(1, 'gnome-open', $url);
895
896 } elsif ($desktop eq "kde") {
897 launchApp(1, 'kfmclient', 'exec', $url);
898
899 } else {
900 if (checkCommand('firefox')) {
901 launchApp(1, 'firefox', $url);
902 } elsif (checkCommand('mozilla')) {
903 launchApp(1, 'mozilla', $url);
904 } else {
905 $interface->errorDialog(TF("No suitable browser detected. Please launch your favorite browser and go to:\n%s", $url));
906 }
907 }
908 }
909}
910
911
912#######################################
913#######################################
914### CATEGORY: Other functions
915#######################################
916#######################################
917
918# TODO: move actorAdded/Removed to Actor?
919sub actorAddedRemovedVars {
920 my ($actor) = @_;
921 # returns (type, list, hash)
922 if ($actor->isa ('Actor::Item')) {
923 return ('item', \@itemsID, \%items);
924 } elsif ($actor->isa ('Actor::Player')) {
925 return ('player', \@playersID, \%players);
926 } elsif ($actor->isa ('Actor::Monster')) {
927 return ('monster', \@monstersID, \%monsters);
928 } elsif ($actor->isa ('Actor::Portal')) {
929 return ('portal', \@portalsID, \%portals);
930 } elsif ($actor->isa ('Actor::Pet')) {
931 return ('pet', \@petsID, \%pets);
932 } elsif ($actor->isa ('Actor::NPC')) {
933 return ('npc', \@npcsID, \%npcs);
934 } elsif ($actor->isa ('Actor::Slave')) {
935 return ('slave', \@slavesID, \%slaves);
936 } else {
937 return (undef, undef, undef);
938 }
939}
940
941sub actorAdded {
942 my (undef, $source, $arg) = @_;
943 my ($actor, $index) = @{$arg};
944
945 $actor->{binID} = $index;
946
947 my ($type, $list, $hash) = actorAddedRemovedVars ($actor);
948
949 if (defined $type) {
950 debug TF("actorAdded: %s %s (%s), size %s\n", $type, (unpack 'V', $actor->{ID}), $actor->{binID}, $source->size), 'actorlist', 3;
951
952 if (DEBUG && scalar(keys %{$hash}) + 1 != $source->size()) {
953 use Data::Dumper;
954
955 my $ol = '';
956 my $items = $source->getItems();
957 foreach my $item (@{$items}) {
958 $ol .= $item->nameIdx . "\n";
959 }
960
961 die "$type: " . scalar(keys %{$hash}) . " + 1 != " . $source->size() . "\n" .
962 "List:\n" .
963 Dumper($list) . "\n" .
964 "Hash:\n" .
965 Dumper($hash) . "\n" .
966 "ObjectList:\n" .
967 $ol;
968 }
969 assert(binSize($list) + 1 == $source->size()) if DEBUG;
970
971 binAdd($list, $actor->{ID});
972 $hash->{$actor->{ID}} = $actor;
973 objectAdded($type, $actor->{ID}, $actor);
974
975 assert(scalar(keys %{$hash}) == $source->size()) if DEBUG;
976 assert(binSize($list) == $source->size()) if DEBUG;
977 } else {
978 warning "Unknown actor type in actorAdded\n", 'actorlist' if DEBUG;
979 }
980}
981
982sub actorRemoved {
983 my (undef, $source, $arg) = @_;
984 my ($actor, $index) = @{$arg};
985
986 my ($type, $list, $hash) = actorAddedRemovedVars ($actor);
987
988 if (defined $type) {
989 debug TF("actorRemoved: %s %s (%s), size %s\n", $type, (unpack 'V', $actor->{ID}), $actor->{binID}, $source->size), 'actorlist', 3;
990
991 if (DEBUG && scalar(keys %{$hash}) - 1 != $source->size()) {
992 use Data::Dumper;
993
994 my $ol = '';
995 my $items = $source->getItems();
996 foreach my $item (@{$items}) {
997 $ol .= $item->nameIdx . "\n";
998 }
999
1000 die "$type:" . scalar(keys %{$hash}) . " - 1 != " . $source->size() . "\n" .
1001 "List:\n" .
1002 Dumper($list) . "\n" .
1003 "Hash:\n" .
1004 Dumper($hash) . "\n" .
1005 "ObjectList:\n" .
1006 $ol;
1007 }
1008 assert(binSize($list) - 1 == $source->size()) if DEBUG;
1009
1010 binRemove($list, $actor->{ID});
1011 delete $hash->{$actor->{ID}};
1012 objectRemoved($type, $actor->{ID}, $actor);
1013
1014 if ($type eq "player" && $venderLists{ID}) {
1015 binRemove(\@venderListsID, $actor->{ID});
1016 delete $venderLists{$actor->{ID}};
1017 }
1018
1019 if ($type eq "player" && $buyerLists{ID}) {
1020 binRemove(\@buyerListsID, $actor->{ID});
1021 delete $buyerLists{$actor->{ID}};
1022 }
1023
1024 assert(scalar(keys %{$hash}) == $source->size()) if DEBUG;
1025 assert(binSize($list) == $source->size()) if DEBUG;
1026 } else {
1027 warning "Unknown actor type in actorRemoved\n", 'actorlist' if DEBUG;
1028 }
1029}
1030
1031sub actorListClearing {
1032 undef %items;
1033 undef %players;
1034 undef %monsters;
1035 undef %portals;
1036 undef %npcs;
1037 undef %pets;
1038 undef %slaves;
1039 undef @itemsID;
1040 undef @playersID;
1041 undef @monstersID;
1042 undef @portalsID;
1043 undef @npcsID;
1044 undef @petsID;
1045 undef @slavesID;
1046}
1047
1048sub avoidGM_talk {
1049 return 0 if ($net->clientAlive() || !$config{avoidGM_talk});
1050 my ($user, $msg) = @_;
1051
1052 # Check whether this "GM" is on the ignore list
1053 # in order to prevent false matches
1054 return 0 if (existsInList($config{avoidGM_ignoreList}, $user));
1055
1056 if ($user =~ /^([a-z]?ro)?-?(Sub)?-?\[?GM\]?/i || $user =~ /$config{avoidGM_namePattern}/) {
1057 my %args = (
1058 name => $user,
1059 );
1060 Plugins::callHook('avoidGM_talk', \%args);
1061 return 1 if ($args{return});
1062
1063 warning T("Disconnecting to avoid GM!\n");
1064 main::chatLog("k", TF("*** The GM %s talked to you, auto disconnected ***\n", $user));
1065
1066 warning TF("Disconnect for %s seconds...\n", $config{avoidGM_reconnect});
1067 relog($config{avoidGM_reconnect}, 1);
1068 return 1;
1069 }
1070 return 0;
1071}
1072
1073sub avoidList_talk {
1074 return 0 if ($net->clientAlive() || !$config{avoidList});
1075 my ($user, $msg, $ID) = @_;
1076
1077 if ($avoid{Players}{lc($user)}{disconnect_on_chat} || $avoid{ID}{$ID}{disconnect_on_chat}) {
1078 warning TF("Disconnecting to avoid %s!\n", $user);
1079 main::chatLog("k", TF("*** %s talked to you, auto disconnected ***\n", $user));
1080 warning TF("Disconnect for %s seconds...\n", $config{avoidList_reconnect});
1081 relog($config{avoidList_reconnect}, 1);
1082 return 1;
1083 }
1084 return 0;
1085}
1086
1087sub calcStat {
1088 my $damage = shift;
1089 $totaldmg += $damage;
1090}
1091
1092##
1093# center(string, width, [fill])
1094#
1095# This function will center $string within a field $width characters wide,
1096# using $fill characters for padding on either end of the string for
1097# centering. If $fill is not specified, a space will be used.
1098sub center {
1099 my ($string, $width, $fill) = @_;
1100
1101 $fill ||= ' ';
1102 my $left = int(($width - length($string)) / 2);
1103 my $right = ($width - length($string)) - $left;
1104 return $fill x $left . $string . $fill x $right;
1105}
1106
1107# Returns: 0 if user chose to quit, 1 if user chose a character, 2 if user created or deleted a character
1108sub charSelectScreen {
1109 my %plugin_args = (autoLogin => shift);
1110 # A list of character names
1111 my @charNames;
1112 # An array which maps an index in @charNames to an index in @chars
1113 my @charNameIndices;
1114 my $mode;
1115
1116 # the client also does this
1117 $questList = {};
1118
1119 TOP: {
1120 undef $mode;
1121 @charNames = ();
1122 @charNameIndices = ();
1123 }
1124
1125 for (my $num = 0; $num < @chars; $num++) {
1126 next unless ($chars[$num] && %{$chars[$num]});
1127 if (0) {
1128 # The old (more verbose) message
1129 swrite(
1130 T("------- Character \@< ---------\n" .
1131 "Name: \@<<<<<<<<<<<<<<<<<<<<<<<<\n" .
1132 "Job: \@<<<<<<< Job Exp: \@<<<<<<<\n" .
1133 "Lv: \@<<<<<<< Str: \@<<<<<<<<\n" .
1134 "J.Lv: \@<<<<<<< Agi: \@<<<<<<<<\n" .
1135 "Exp: \@<<<<<<< Vit: \@<<<<<<<<\n" .
1136 "HP: \@||||/\@|||| Int: \@<<<<<<<<\n" .
1137 "SP: \@||||/\@|||| Dex: \@<<<<<<<<\n" .
1138 "zeny: \@<<<<<<<<<< Luk: \@<<<<<<<<\n" .
1139 "-------------------------------"),
1140 $num, $chars[$num]{'name'}, $jobs_lut{$chars[$num]{'jobID'}}, $chars[$num]{'exp_job'},
1141 $chars[$num]{'lv'}, $chars[$num]{'str'}, $chars[$num]{'lv_job'}, $chars[$num]{'agi'},
1142 $chars[$num]{'exp'}, $chars[$num]{'vit'}, $chars[$num]{'hp'}, $chars[$num]{'hp_max'},
1143 $chars[$num]{'int'}, $chars[$num]{'sp'}, $chars[$num]{'sp_max'}, $chars[$num]{'dex'},
1144 $chars[$num]{'zeny'}, $chars[$num]{'luk'});
1145 }
1146 push @charNames, TF("Slot %d: %s (%s, level %d/%d)",
1147 $num,
1148 $chars[$num]{name},
1149 $jobs_lut{$chars[$num]{'jobID'}},
1150 $chars[$num]{lv},
1151 $chars[$num]{lv_job});
1152 push @charNameIndices, $num;
1153 }
1154
1155 if (@charNames) {
1156 message(TF("------------- Character List -------------\n" .
1157 "%s\n" .
1158 "------------------------------------------\n",
1159 join("\n", @charNames)),
1160 "connection");
1161 }
1162 return 1 if $net->clientAlive;
1163
1164 Plugins::callHook('charSelectScreen', \%plugin_args);
1165 return $plugin_args{return} if ($plugin_args{return});
1166
1167 if ($plugin_args{autoLogin} && @chars && $config{char} ne "" && $chars[$config{char}]) {
1168 $messageSender->sendCharLogin($config{char});
1169 $timeout{charlogin}{time} = time;
1170 return 1;
1171 }
1172
1173 my @choices = @charNames;
1174 push @choices, T('Create a new character');
1175 if (@chars) {
1176 push @choices, T('Delete a character');
1177 } else {
1178 message T("There are no characters on this account.\n"), "connection";
1179 }
1180
1181 my $choice = $interface->showMenu(
1182 T("Please choose a character or an action."), \@choices,
1183 title => T("Character selection"));
1184 if ($choice == -1) {
1185 # User cancelled
1186 quit();
1187 return 0;
1188
1189 } elsif ($choice < @charNames) {
1190 # Character chosen
1191 configModify('char', $charNameIndices[$choice], 1);
1192 $messageSender->sendCharLogin($config{char});
1193 $timeout{charlogin}{time} = time;
1194 return 1;
1195
1196 } elsif ($choice == @charNames) {
1197 # 'Create character' chosen
1198 $mode = "create";
1199
1200 } else {
1201 # 'Delete character' chosen
1202 $mode = "delete";
1203 }
1204
1205 if ($mode eq "create") {
1206 while (1) {
1207 my $message = T("Please enter the desired properties for your characters, in this form:\n" .
1208 "(slot) \"(name)\" [ (str) (agi) (vit) (int) (dex) (luk) [ (hairstyle) [(haircolor)] ] ]");
1209 my $input = $interface->query($message);
1210 unless ($input =~ /\S/) {
1211 goto TOP;
1212 } else {
1213 my @args = parseArgs($input);
1214 if (@args < 2) {
1215 $interface->errorDialog(T("You didn't specify enough parameters."), 0);
1216 next;
1217 }
1218
1219 message TF("Creating character \"%s\" in slot \"%s\"...\n", $args[1], $args[0]), "connection";
1220 $timeout{charlogin}{time} = time;
1221 last if (createCharacter(@args));
1222 }
1223 }
1224
1225 } elsif ($mode eq "delete") {
1226 my $choice = $interface->showMenu(
1227 T("Select the character you want to delete."),
1228 \@charNames,
1229 title => T("Delete character"));
1230 if ($choice == -1) {
1231 goto TOP;
1232 }
1233 my $charIndex = @charNameIndices[$choice];
1234
1235 my $email = $interface->query("Enter your email address.");
1236 if (!defined($email)) {
1237 goto TOP;
1238 }
1239
1240 my $confirmation = $interface->showMenu(
1241 TF("Are you ABSOLUTELY SURE you want to delete:\n%s", $charNames[$choice]),
1242 [T("No, don't delete"), T("Yes, delete")],
1243 title => T("Confirm delete"));
1244 if ($confirmation != 1) {
1245 goto TOP;
1246 }
1247
1248 $messageSender->sendCharDelete($chars[$charIndex]{charID}, $email);
1249 message TF("Deleting character %s...\n", $chars[$charIndex]{name}), "connection";
1250 $AI::temp::delIndex = $charIndex;
1251 $timeout{charlogin}{time} = time;
1252 }
1253 return 2;
1254}
1255
1256sub chatLog_clear {
1257 if (-f $Settings::chat_log_file) {
1258 unlink($Settings::chat_log_file);
1259 }
1260}
1261
1262##
1263# checkAllowedMap($map)
1264#
1265# Checks whether $map is in $config{allowedMaps}.
1266# Disconnects if it is not, and $config{allowedMaps_reaction} != 0.
1267sub checkAllowedMap {
1268 my $map = shift;
1269
1270 return unless $AI == AI::AUTO;
1271 return unless $config{allowedMaps};
1272 return if existsInList($config{allowedMaps}, $map);
1273 return if $config{allowedMaps_reaction} == 0;
1274
1275 warning TF("The current map (%s) is not on the list of allowed maps.\n", $map);
1276 main::chatLog("k", TF("** The current map (%s) is not on the list of allowed maps.\n", $map));
1277 main::chatLog("k", T("** Exiting...\n"));
1278 quit();
1279}
1280
1281##
1282# checkFollowMode()
1283# Returns: 1 if in follow mode, 0 if not.
1284#
1285# Check whether we're current in follow mode.
1286sub checkFollowMode {
1287 my $followIndex;
1288 if ($config{follow} && defined($followIndex = AI::findAction("follow"))) {
1289 return 1 if (AI::args($followIndex)->{following});
1290 }
1291 return 0;
1292}
1293
1294##
1295# boolean checkMonsterCleanness(Bytes ID)
1296# ID: the monster's ID.
1297# Requires: $ID is a valid monster ID.
1298#
1299# Checks whether a monster is "clean" (not being attacked by anyone).
1300sub checkMonsterCleanness {
1301 return 1;
1302 return 1 if (!$config{attackAuto});
1303 my $ID = $_[0];
1304 return 1 if $playersList->getByID($ID) || $slavesList->getByID($ID);
1305 my $monster = $monstersList->getByID($ID);
1306
1307 # If party attacked monster, or if monster attacked/missed party
1308 if ($monster->{dmgFromParty} > 0 || $monster->{missedFromParty} > 0 || $monster->{dmgToParty} > 0 || $monster->{missedToParty} > 0) {
1309 return 1;
1310 }
1311
1312 if ($config{aggressiveAntiKS}) {
1313 # Aggressive anti-KS mode, for people who are paranoid about not kill stealing.
1314
1315 # If we attacked the monster first, do not drop it, we are being KSed
1316 return 1 if ($monster->{dmgFromYou} || $monster->{missedFromYou});
1317
1318 # If others attacked the monster then always drop it, wether it attacked us or not!
1319 return 0 if (($monster->{dmgFromPlayer} && %{$monster->{dmgFromPlayer}})
1320 || ($monster->{missedFromPlayer} && %{$monster->{missedFromPlayer}})
1321 || (($monster->{castOnByPlayer}) && %{$monster->{castOnByPlayer}})
1322 || (($monster->{castOnToPlayer}) && %{$monster->{castOnToPlayer}}));
1323 }
1324
1325 # If monster attacked/missed you
1326 return 1 if ($monster->{'dmgToYou'} || $monster->{'missedYou'});
1327
1328 # If we're in follow mode
1329 if (defined(my $followIndex = AI::findAction("follow"))) {
1330 my $following = AI::args($followIndex)->{following};
1331 my $followID = AI::args($followIndex)->{ID};
1332
1333 if ($following) {
1334 # And master attacked monster, or the monster attacked/missed master
1335 if ($monster->{dmgToPlayer}{$followID} > 0
1336 || $monster->{missedToPlayer}{$followID} > 0
1337 || $monster->{dmgFromPlayer}{$followID} > 0) {
1338 return 1;
1339 }
1340 }
1341 }
1342
1343 if (objectInsideSpell($monster)) {
1344 # Prohibit attacking this monster in the future
1345 $monster->{dmgFromPlayer}{$char->{ID}} = 1;
1346 return 0;
1347 }
1348
1349 #check party casting on mob
1350 my $allowed = 1;
1351 if (scalar(keys %{$monster->{castOnByPlayer}}) > 0)
1352 {
1353 foreach (keys %{$monster->{castOnByPlayer}})
1354 {
1355 my $ID1=$_;
1356 my $source = Actor::get($_);
1357 unless ( existsInList($config{tankersList}, $source->{name}) ||
1358 ($char->{party} && %{$char->{party}} && $char->{party}{users}{$ID1} && %{$char->{party}{users}{$ID1}}))
1359 {
1360 $allowed = 0;
1361 last;
1362 }
1363 }
1364 }
1365
1366 # If monster hasn't been attacked by other players
1367 if (scalar(keys %{$monster->{missedFromPlayer}}) == 0
1368 && scalar(keys %{$monster->{dmgFromPlayer}}) == 0
1369 #&& scalar(keys %{$monster->{castOnByPlayer}}) == 0 #change to $allowed
1370 && $allowed
1371
1372 # and it hasn't attacked any other player
1373 && scalar(keys %{$monster->{missedToPlayer}}) == 0
1374 && scalar(keys %{$monster->{dmgToPlayer}}) == 0
1375 && scalar(keys %{$monster->{castOnToPlayer}}) == 0
1376 ) {
1377 # The monster might be getting lured by another player.
1378 # So we check whether it's walking towards any other player, but only
1379 # if we haven't already attacked the monster.
1380 if ($monster->{dmgFromYou} || $monster->{missedFromYou}) {
1381 return 1;
1382 } else {
1383 return !objectIsMovingTowardsPlayer($monster);
1384 }
1385 }
1386
1387 # The monster didn't attack you.
1388 # Other players attacked it, or it attacked other players.
1389 if ($monster->{dmgFromYou} || $monster->{missedFromYou}) {
1390 # If you have already attacked the monster before, then consider it clean
1391 return 1;
1392 }
1393 # If you haven't attacked the monster yet, it's unclean.
1394
1395 return 0;
1396}
1397
1398##
1399# boolean createCharacter(int slot, String name, int [str,agi,vit,int,dex,luk] = 5)
1400# slot: The slot in which to create the character (1st slot is 0).
1401# name: The name of the character to create.
1402# Returns: Whether the parameters are correct. Only a character creation command
1403# will be sent to the server if all parameters are correct.
1404#
1405# Create a new character. You must be currently connected to the character login server.
1406sub createCharacter {
1407 my $slot = shift;
1408 my $name = shift;
1409 my ($str,$agi,$vit,$int,$dex,$luk, $hair_style, $hair_color) = @_;
1410
1411 if (!@_) {
1412 ($str,$agi,$vit,$int,$dex,$luk) = (5,5,5,5,5,5);
1413 }
1414
1415 if ($net->getState() != 3) {
1416 $interface->errorDialog(T("We're not currently connected to the character login server."), 0);
1417 return 0;
1418 } elsif ($slot !~ /^\d+$/) {
1419 $interface->errorDialog(TF("Slot \"%s\" is not a valid number.", $slot), 0);
1420 return 0;
1421 } elsif ($slot < 0 || $slot > 4) {
1422 $interface->errorDialog(T("The slot must be comprised between 0 and 4."), 0); # TODO: private servers allow more slots
1423 return 0;
1424 } elsif ($chars[$slot]) {
1425 $interface->errorDialog(TF("Slot %s already contains a character (%s).", $slot, $chars[$slot]{name}), 0);
1426 return 0;
1427 } elsif (length($name) > 23) {
1428 $interface->errorDialog(T("Name must not be longer than 23 characters."), 0);
1429 return 0;
1430
1431 } else {
1432 for ($str,$agi,$vit,$int,$dex,$luk) {
1433 if ($_ > 9 || $_ < 1) {
1434 $interface->errorDialog(T("Stats must be comprised between 1 and 9."), 0);
1435 return;
1436 }
1437 }
1438 for ($str+$int, $agi+$luk, $vit+$dex) {
1439 if ($_ != 10) {
1440 $interface->errorDialog(T("The sums Str + Int, Agi + Luk and Vit + Dex must all be equal to 10."), 0);
1441 return;
1442 }
1443 }
1444
1445 $messageSender->sendCharCreate($slot, $name,
1446 $str, $agi, $vit, $int, $dex, $luk,
1447 $hair_style, $hair_color);
1448 return 1;
1449 }
1450}
1451
1452##
1453# void deal(Actor::Player player)
1454# Requires: defined($player)
1455# Ensures: exists $outgoingDeal{ID}
1456#
1457# Sends $player a deal request.
1458sub deal {
1459 my $player = $_[0];
1460 assert(defined $player) if DEBUG;
1461 assert(UNIVERSAL::isa($player, 'Actor::Player')) if DEBUG;
1462
1463 $outgoingDeal{ID} = $player->{ID};
1464 $messageSender->sendDeal($player->{ID});
1465}
1466
1467##
1468# dealAddItem($item, $amount)
1469#
1470# Adds $amount of $item to the current deal.
1471sub dealAddItem {
1472 my ($item, $amount) = @_;
1473
1474 $messageSender->sendDealAddItem($item->{index}, $amount);
1475 $currentDeal{lastItemAmount} = $amount;
1476}
1477
1478##
1479# drop(itemIndex, amount)
1480#
1481# Drops $amount of the item specified by $itemIndex. If $amount is not specified or too large, it defaults
1482# to the number of items you have.
1483sub drop {
1484 my ($itemIndex, $amount) = @_;
1485 my $item = $char->inventory->get($itemIndex);
1486 if ($item) {
1487 if (!$amount || $amount > $item->{amount}) {
1488 $amount = $item->{amount};
1489 }
1490 $messageSender->sendDrop($item->{index}, $amount);
1491 }
1492}
1493
1494sub dumpData {
1495 my $msg = shift;
1496 my $silent = shift;
1497 my $dump;
1498 my $puncations = quotemeta '~!@#$%^&*()_+|\"\'';
1499
1500 $dump = "\n\n================================================\n" .
1501 getFormattedDate(int(time)) . "\n\n" .
1502 length($msg) . " bytes\n\n";
1503
1504 for (my $i = 0; $i < length($msg); $i += 16) {
1505 my $line;
1506 my $data = substr($msg, $i, 16);
1507 my $rawData = '';
1508
1509 for (my $j = 0; $j < length($data); $j++) {
1510 my $char = substr($data, $j, 1);
1511
1512 if (($char =~ /\W/ && $char =~ /\S/ && !($char =~ /[$puncations]/))
1513 || ($char eq chr(10) || $char eq chr(13) || $char eq "\t")) {
1514 $rawData .= '.';
1515 } else {
1516 $rawData .= substr($data, $j, 1);
1517 }
1518 }
1519
1520 $line = getHex(substr($data, 0, 8));
1521 $line .= ' ' . getHex(substr($data, 8)) if (length($data) > 8);
1522
1523 $line .= ' ' x (50 - length($line)) if (length($line) < 54);
1524 $line .= " $rawData\n";
1525 $line = sprintf("%3d> ", $i) . $line;
1526 $dump .= $line;
1527 }
1528
1529 open DUMP, ">> DUMP.txt";
1530 print DUMP $dump;
1531 close DUMP;
1532
1533 debug "$dump\n", "parseMsg", 2;
1534 message T("Message Dumped into DUMP.txt!\n"), undef, 1 unless ($silent);
1535}
1536
1537sub getEmotionByCommand {
1538 my $command = shift;
1539 foreach (keys %emotions_lut) {
1540 if (existsInList($emotions_lut{$_}{command}, $command)) {
1541 return $_;
1542 }
1543 }
1544 return undef;
1545}
1546
1547sub getIDFromChat {
1548 my $r_hash = shift;
1549 my $msg_user = shift;
1550 my $match_text = shift;
1551 my $qm;
1552 if ($match_text !~ /\w+/ || $match_text eq "me" || $match_text eq "") {
1553 foreach (keys %{$r_hash}) {
1554 next if ($_ eq "");
1555 if ($msg_user eq $r_hash->{$_}{name}) {
1556 return $_;
1557 }
1558 }
1559 } else {
1560 foreach (keys %{$r_hash}) {
1561 next if ($_ eq "");
1562 $qm = quotemeta $match_text;
1563 if ($r_hash->{$_}{name} =~ /$qm/i) {
1564 return $_;
1565 }
1566 }
1567 }
1568 return undef;
1569}
1570
1571##
1572# getNPCName(ID)
1573# ID: the packed ID of the NPC
1574# Returns: the name of the NPC
1575#
1576# Find the name of an NPC: could be NPC, monster, or unknown.
1577sub getNPCName {
1578 my $ID = shift;
1579 if ((my $npc = $npcsList->getByID($ID))) {
1580 return $npc->name;
1581 } elsif ((my $monster = $monstersList->getByID($ID))) {
1582 return $monster->name;
1583 } else {
1584 return "Unknown #" . unpack("V1", $ID);
1585 }
1586}
1587
1588##
1589# getPlayerNameFromCache(player)
1590# player: an Actor::Player object.
1591# Returns: 1 on success, 0 if the player isn't in cache.
1592#
1593# Retrieve a player's name from cache and modify the player object.
1594sub getPlayerNameFromCache {
1595 my ($player) = @_;
1596
1597 return if (!$config{cachePlayerNames});
1598 my $entry = $playerNameCache{$player->{ID}};
1599 return if (!$entry);
1600
1601 # Check whether the cache entry is too old or inconsistent.
1602 # Default cache life time: 15 minutes.
1603 if (timeOut($entry->{time}, $config{cachePlayerNames_duration}) || $player->{lv} != $entry->{lv} || $player->{jobID} != $entry->{jobID}) {
1604 binRemove(\@playerNameCacheIDs, $player->{ID});
1605 delete $playerNameCache{$player->{ID}};
1606 compactArray(\@playerNameCacheIDs);
1607 return 0;
1608 }
1609
1610 $player->{name} = $entry->{name};
1611 $player->{guild} = $entry->{guild} if ($entry->{guild});
1612 return 1;
1613}
1614
1615sub getPortalDestName {
1616 my $ID = shift;
1617 my %hash; # We only want unique names, so we use a hash
1618 foreach (keys %{$portals_lut{$ID}{'dest'}}) {
1619 my $key = $portals_lut{$ID}{'dest'}{$_}{'map'};
1620 $hash{$key} = 1;
1621 }
1622
1623 my @destinations = sort keys %hash;
1624 return join('/', @destinations);
1625}
1626
1627sub getResponse {
1628 my $type = quotemeta shift;
1629
1630 my @keys;
1631 foreach my $key (keys %responses) {
1632 if ($key =~ /^$type\_\d+$/) {
1633 push @keys, $key;
1634 }
1635 }
1636
1637 my $msg = $responses{$keys[int(rand(@keys))]};
1638 $msg =~ s/\%\$(\w+)/$responseVars{$1}/eig;
1639 return $msg;
1640}
1641
1642sub getSpellName {
1643 my $spell = shift;
1644 return $spells_lut{$spell} || "Unknown $spell";
1645}
1646
1647##
1648# inInventory($itemName, $quantity = 1)
1649#
1650# Returns the item's index (can be 0!) if you have at least $quantity units of the item
1651# specified by $itemName in your inventory.
1652# Returns nothing otherwise.
1653sub inInventory {
1654 my ($itemIndex, $quantity) = @_;
1655 $quantity ||= 1;
1656
1657 my $item = $char->inventory->getByName($itemIndex);
1658 return if !$item;
1659 return unless $item->{amount} >= $quantity;
1660 return $item->{invIndex};
1661}
1662
1663##
1664# inventoryItemRemoved($invIndex, $amount)
1665#
1666# Removes $amount of $invIndex from $char->{inventory}.
1667# Also prints a message saying the item was removed (unless it is an arrow you
1668# fired).
1669sub inventoryItemRemoved {
1670 my ($invIndex, $amount) = @_;
1671
1672 my $item = $char->inventory->get($invIndex);
1673 if (!$char->{arrow} || ($item && $char->{arrow} != $item->{index})) {
1674 # This item is not an equipped arrow
1675 message TF("Inventory Item Removed: %s (%d) x %d\n", $item->{name}, $invIndex, $amount), "inventory";
1676 }
1677 $item->{amount} -= $amount;
1678 $char->inventory->remove($item) if ($item->{amount} <= 0);
1679 $itemChange{$item->{name}} -= $amount;
1680}
1681
1682# Resolve the name of a card
1683sub cardName {
1684 my $cardID = shift;
1685
1686 # If card name is unknown, just return ?number
1687 my $card = $items_lut{$cardID};
1688 return "?$cardID" if !$card;
1689 $card =~ s/ Card$//;
1690 return $card;
1691}
1692
1693# Resolve the name of a monster
1694# This function will only look at the data in monsters.txt
1695# DO NOT USE THIS FUNCTION when you want to get the real name of a monster,
1696# servers can change this name internally use getNPCName instead.
1697sub monsterName {
1698 my $ID = shift;
1699 return 'Unknown' unless defined($ID);
1700 return 'None' unless $ID;
1701 return $monsters_lut{$ID} || "Unknown #$ID";
1702}
1703
1704# Resolve the name of a simple item
1705sub itemNameSimple {
1706 my $ID = shift;
1707 return 'Unknown' unless defined($ID);
1708 return 'None' unless $ID;
1709 return $items_lut{$ID} || "Unknown #$ID";
1710}
1711
1712##
1713# itemName($item)
1714#
1715# Resolve the name of an item. $item should be a hash with these keys:
1716# nameID => integer index into %items_lut
1717# cards => 8-byte binary data as sent by server
1718# upgrade => integer upgrade level
1719sub itemName {
1720 my $item = shift;
1721
1722 my $name = itemNameSimple($item->{nameID});
1723
1724 # Resolve item prefix/suffix (carded or forged)
1725 my $prefix = "";
1726 my $suffix = "";
1727 my @cards;
1728 my %cards;
1729 for (my $i = 0; $i < 4; $i++) {
1730 my $card = unpack("v1", substr($item->{cards}, $i*2, 2));
1731 next unless $card;
1732 push(@cards, $card);
1733 ($cards{$card} ||= 0) += 1;
1734 }
1735 if ($cards[0] == 254) {
1736 # Alchemist-made potion
1737 #
1738 # Ignore the "cards" inside.
1739 } elsif ($cards[0] == 65280) {
1740 # Pet egg
1741 # cards[0] == 65280
1742 # substr($item->{cards}, 2, 4) = packed pet ID
1743 # cards[3] == 1 if named, 0 if not named
1744
1745 } elsif ($cards[0] == 255) {
1746 # Forged weapon
1747 #
1748 # Display e.g. "VVS Earth" or "Fire"
1749 my $elementID = $cards[1] % 10;
1750 my $elementName = $elements_lut{$elementID};
1751 my $starCrumbs = ($cards[1] >> 8) / 5;
1752 $prefix .= ('V'x$starCrumbs)."S " if $starCrumbs;
1753 $prefix .= "$elementName " if ($elementName ne "");
1754 $suffix = "$elementName" if ($elementName ne "");
1755 } elsif (@cards) {
1756 # Carded item
1757 #
1758 # List cards in alphabetical order.
1759 # Stack identical cards.
1760 # e.g. "Hydra*2,Mummy*2", "Hydra*3,Mummy"
1761 $suffix = join(':', map {
1762 cardName($_).($cards{$_} > 1 ? "*$cards{$_}" : '')
1763 } sort { cardName($a) cmp cardName($b) } keys %cards);
1764 }
1765
1766 my $numSlots = $itemSlotCount_lut{$item->{nameID}} if ($prefix eq "");
1767
1768 my $display = "";
1769 $display .= "BROKEN " if $item->{broken};
1770 $display .= "+$item->{upgrade} " if $item->{upgrade};
1771 $display .= $prefix if $prefix;
1772 $display .= $name;
1773 $display .= " [$suffix]" if $suffix;
1774 $display .= " [$numSlots]" if $numSlots;
1775
1776 return $display;
1777}
1778
1779##
1780# storageGet(items, max)
1781# items: reference to an array of storage item hashes.
1782# max: the maximum amount to get, for each item, or 0 for unlimited.
1783#
1784# Get one or more items from storage.
1785#
1786# Example:
1787# # Get items $a and $b from storage.
1788# storageGet([$a, $b]);
1789# # Get items $a and $b from storage, but at most 30 of each item.
1790# storageGet([$a, $b], 30);
1791sub storageGet {
1792 my $indices = shift;
1793 my $max = shift;
1794
1795 if (@{$indices} == 1) {
1796 my ($item) = @{$indices};
1797 if (!defined($max) || $max > $item->{amount}) {
1798 $max = $item->{amount};
1799 }
1800 $messageSender->sendStorageGet($item->{index}, $max);
1801
1802 } else {
1803 my %args;
1804 $args{items} = $indices;
1805 $args{max} = $max;
1806 $args{timeout} = 0.15;
1807 AI::queue("storageGet", \%args);
1808 }
1809}
1810
1811##
1812# headgearName(lookID)
1813#
1814# Resolves a lookID of a headgear into a human readable string.
1815#
1816# A lookID corresponds to a line number in tables/headgears.txt.
1817# The number on that line is the itemID for the headgear.
1818sub headgearName {
1819 my ($lookID) = @_;
1820
1821 return "Nothing" if $lookID == 0;
1822
1823 my $itemID = $headgears_lut[$lookID];
1824
1825 if (!defined($itemID)) {
1826 return "Unknown lookID $lookID";
1827 }
1828
1829 return main::itemName({nameID => $itemID});
1830}
1831
1832##
1833# void initUserSeed()
1834#
1835# Generate a unique seed for the current user and save it to
1836# a file, or load the seed from that file if it exists.
1837sub initUserSeed {
1838 my $seedFile = "$Settings::logs_folder/seed.txt";
1839 my $f;
1840
1841 if (-f $seedFile) {
1842 if (open($f, "<", $seedFile)) {
1843 binmode $f;
1844 $userSeed = <$f>;
1845 $userSeed =~ s/\n.*//s;
1846 close($f);
1847 } else {
1848 $userSeed = '0';
1849 }
1850 } else {
1851 $userSeed = '';
1852 for (0..10) {
1853 $userSeed .= rand(2 ** 49);
1854 }
1855
1856 if (open($f, ">", $seedFile)) {
1857 binmode $f;
1858 print $f $userSeed;
1859 close($f);
1860 }
1861 }
1862}
1863
1864sub itemLog_clear {
1865 if (-f $Settings::item_log_file) { unlink($Settings::item_log_file); }
1866}
1867
1868##
1869# look(bodydir, [headdir])
1870# bodydir: a number 0-7. See directions.txt.
1871# headdir: 0 = look directly, 1 = look right, 2 = look left
1872#
1873# Look in the given directions.
1874sub look {
1875 my %args = (
1876 look_body => shift,
1877 look_head => shift
1878 );
1879 AI::queue("look", \%args);
1880}
1881
1882##
1883# lookAtPosition(pos, [headdir])
1884# pos: a reference to a coordinate hash.
1885# headdir: 0 = face directly, 1 = look right, 2 = look left
1886#
1887# Turn face and body direction to position %pos.
1888sub lookAtPosition {
1889 my $pos2 = shift;
1890 my $headdir = shift;
1891 my %vec;
1892 my $direction;
1893
1894 getVector(\%vec, $pos2, $char->{pos_to});
1895 $direction = int(sprintf("%.0f", (360 - vectorToDegree(\%vec)) / 45)) % 8;
1896 look($direction, $headdir);
1897}
1898
1899##
1900# manualMove(dx, dy)
1901#
1902# Moves the character offset from its current position.
1903sub manualMove {
1904 my ($dx, $dy) = @_;
1905
1906 # Stop following if necessary
1907 if ($config{'follow'}) {
1908 configModify('follow', 0);
1909 AI::clear('follow');
1910 }
1911
1912 # Stop moving if necessary
1913 AI::clear(qw/move route mapRoute/);
1914 main::ai_route($field->baseName, $char->{pos_to}{x} + $dx, $char->{pos_to}{y} + $dy);
1915}
1916
1917##
1918# meetingPosition(ID, attackMaxDistance)
1919# ID: ID of the character to meet.
1920# attackMaxDistance: attack distance based on attack method.
1921#
1922# Returns: the position where the character should go to meet a moving monster.
1923sub meetingPosition {
1924 my ($target, $attackMaxDistance) = @_;
1925 my $monsterSpeed = ($target->{walk_speed}) ? 1 / $target->{walk_speed} : 0;
1926 my $timeMonsterMoves = time - $target->{time_move};
1927
1928 my %monsterPos;
1929 $monsterPos{x} = $target->{pos}{x};
1930 $monsterPos{y} = $target->{pos}{y};
1931 my %monsterPosTo;
1932 $monsterPosTo{x} = $target->{pos_to}{x};
1933 $monsterPosTo{y} = $target->{pos_to}{y};
1934
1935 my %realMonsterPos = calcPosFromTime(\%monsterPos, \%monsterPosTo, $monsterSpeed, $timeMonsterMoves);
1936
1937 my $mySpeed = ($char->{walk_speed}) ? 1 / $char->{walk_speed} : 0;
1938 my $timeCharMoves = time - $char->{time_move};
1939
1940 my %myPos;
1941 $myPos{x} = $char->{pos}{x};
1942 $myPos{y} = $char->{pos}{y};
1943 my %myPosTo;
1944 $myPosTo{x} = $char->{pos_to}{x};
1945 $myPosTo{y} = $char->{pos_to}{y};
1946
1947 my %realMyPos = calcPosFromTime(\%myPos, \%myPosTo, $mySpeed, $timeCharMoves);
1948
1949 my $timeMonsterWalks;
1950 my $timeCharWalks;
1951 my %monsterStep;
1952 my %charStep;
1953 # There can not be zero step if monster moves
1954 for (my $monsterStep = 1; $monsterStep <= countSteps(\%realMonsterPos, \%monsterPosTo); $monsterStep++) {
1955 # Calculate the steps
1956 %monsterStep = moveAlong(\%realMonsterPos, \%monsterPosTo, $monsterStep);
1957
1958 # Calculate time to walk for monster
1959 $timeMonsterWalks = calcTime(\%realMonsterPos, \%monsterStep, $monsterSpeed);
1960
1961 # Character's route to monsterStep position
1962 for (my $charStep = 0; $charStep <= countSteps(\%realMyPos, \%monsterStep); $charStep++) {
1963 # Calculate the steps
1964 %charStep = moveAlong(\%realMyPos, \%monsterStep, $charStep);
1965
1966 # Check whether the distance is fine
1967 if (round(distance(\%charStep, \%monsterStep)) <= $attackMaxDistance) {
1968 # Calculate time to walk for char
1969 $timeCharWalks = calcTime(\%realMyPos, \%charStep, $mySpeed);
1970
1971 # Check whether character comes earlier or at the same time
1972 if ($timeCharWalks <= $timeMonsterWalks) {
1973 return \%charStep;
1974 }
1975 }
1976 }
1977 }
1978 # If the monster is too fast, move to its pos_to plus attackMaxDistance
1979 for (my $charStep = 0; $charStep <= countSteps(\%realMyPos, \%monsterPosTo); $charStep++) {
1980 # Calculate the steps
1981 %charStep = moveAlong(\%realMyPos, \%monsterPosTo, $charStep);
1982
1983 # Check whether the distance is fine
1984 if (round(distance(\%charStep, \%monsterPosTo)) <= $attackMaxDistance) {
1985 last;
1986 }
1987 }
1988 return \%charStep;
1989}
1990
1991sub objectAdded {
1992 my ($type, $ID, $obj) = @_;
1993
1994 if ($type eq 'player' || $type eq 'slave') {
1995 # Try to retrieve the player name from cache.
1996 if (!getPlayerNameFromCache($obj)) {
1997 push @unknownPlayers, $ID;
1998 }
1999
2000 } elsif ($type eq 'npc') {
2001 push @unknownNPCs, $ID;
2002 }
2003
2004 if ($type eq 'monster') {
2005 if (mon_control($obj->{name},$obj->{nameID})->{teleport_search}) {
2006 $ai_v{temp}{searchMonsters}++;
2007 }
2008 }
2009
2010 Plugins::callHook('objectAdded', {
2011 type => $type,
2012 ID => $ID,
2013 obj => $obj
2014 });
2015}
2016
2017sub objectRemoved {
2018 my ($type, $ID, $obj) = @_;
2019
2020 if ($type eq 'monster') {
2021 if (mon_control($obj->{name},$obj->{nameID})->{teleport_search}) {
2022 $ai_v{temp}{searchMonsters}--;
2023 }
2024 }
2025
2026 Plugins::callHook('objectRemoved', {
2027 type => $type,
2028 ID => $ID
2029 });
2030}
2031
2032##
2033# items_control($name)
2034#
2035# Returns the items_control.txt settings for item name $name.
2036# If $name has no specific settings, use 'all'.
2037sub items_control {
2038 my ($name) = @_;
2039
2040 return $items_control{lc($name)} || $items_control{all} || {};
2041}
2042
2043##
2044# mon_control($name)
2045#
2046# Returns the mon_control.txt settings for monster name $name.
2047# If $name has no specific settings, use 'all'.
2048sub mon_control {
2049 my $name = shift;
2050 my $nameID = shift;
2051 return $mon_control{lc($name)} || $mon_control{$nameID} || $mon_control{all} || { attack_auto => 1 };
2052}
2053
2054##
2055# pickupitems($name)
2056#
2057# Returns the pickupitems.txt settings for item name $name.
2058# If $name has no specific settings, use 'all'.
2059sub pickupitems {
2060 my ($name) = @_;
2061
2062 return ($pickupitems{lc($name)} ne '') ? $pickupitems{lc($name)} : $pickupitems{all};
2063}
2064
2065sub positionNearPlayer {
2066 my $r_hash = shift;
2067 my $dist = shift;
2068
2069 my $players = $playersList->getItems();
2070 foreach my $player (@{$players}) {
2071 my $ID = $player->{ID};
2072 next if ($char->{party} && $char->{party}{users} &&
2073 $char->{party}{users}{$ID});
2074 next if (defined($player->{name}) && existsInList($config{tankersList}, $player->{name}));
2075 return 1 if (distance($r_hash, $player->{pos_to}) <= $dist);
2076 }
2077 return 0;
2078}
2079
2080sub positionNearPortal {
2081 my $r_hash = shift;
2082 my $dist = shift;
2083
2084 my $portals = $portalsList->getItems();
2085 foreach my $portal (@{$portals}) {
2086 return 1 if (distance($r_hash, $portal->{pos}) <= $dist);
2087 }
2088 return 0;
2089}
2090
2091##
2092# printItemDesc(itemID)
2093#
2094# Print the description for $itemID.
2095sub printItemDesc {
2096 my $itemID = shift;
2097 my $itemName = itemNameSimple($itemID);
2098 my $description = $itemsDesc_lut{$itemID} || T("Error: No description available.\n");
2099 message TF("===============Item Description===============\nItem: %s (ID: %s)\n\n", $itemName, $itemID), "info";
2100 message($description, "info");
2101 message("==============================================\n", "info");
2102}
2103
2104sub processNameRequestQueue {
2105 my ($queue, $actorLists, $foo) = @_;
2106
2107 while (@{$queue}) {
2108 my $ID = $queue->[0];
2109
2110 my $actor;
2111 foreach my $actorList (@$actorLists) {
2112 last if $actor = $actorList->getByID($ID);
2113 }
2114
2115 # Some private servers ban you if you request info for an object with
2116 # GM Perfect Hide status
2117 if (!$actor || defined($actor->{name}) || $actor->statusActive('EFFECTSTATE_SPECIALHIDING')) {
2118 shift @{$queue};
2119 next;
2120 }
2121
2122 # Remove actors with a distance greater than clientSight. Some private servers (notably Freya) use
2123 # a technique where they send actor_exists packets with ridiculous distances in order to automatically
2124 # ban bots. By removingthose actors, we eliminate that possibility and emulate the client more closely.
2125 if (defined $actor->{pos_to} && (my $block_dist = blockDistance($char->{pos_to}, $actor->{pos_to})) >= ($config{clientSight} || 16)) {
2126 debug "Removed actor at $actor->{pos_to}{x} $actor->{pos_to}{y} (distance: $block_dist)\n";
2127 shift @{$queue};
2128 next;
2129 }
2130
2131 $messageSender->sendGetPlayerInfo($ID) if (isSafeActorQuery($ID) == 1); # Do not Query GM's
2132 $actor = shift @{$queue};
2133 push @{$queue}, $actor if ($actor);
2134 last;
2135 }
2136}
2137
2138sub quit {
2139 $quit = 1;
2140 message T("Exiting...\n"), "system";
2141}
2142
2143sub relog {
2144 my $timeout = (shift || 5);
2145 my $silent = shift;
2146 $net->setState(1) if ($net);
2147 undef $conState_tries;
2148 $timeout_ex{'master'}{'time'} = time;
2149 $timeout_ex{'master'}{'timeout'} = $timeout;
2150 $net->serverDisconnect() if ($net);
2151 message TF("Relogging in %d seconds...\n", $timeout), "connection" unless $silent;
2152}
2153
2154##
2155# sendMessage(String type, String msg, String user)
2156# type: Specifies what kind of message this is. "c" for public chat, "g" for guild chat,
2157# "p" for party chat, "pm" for private message, "k" for messages that only the RO
2158# client will see (in X-Kore mode.)
2159# msg: The message to send.
2160# user:
2161#
2162# Send a chat message to a user.
2163sub sendMessage {
2164 my ($sender, $type, $msg, $user) = @_;
2165 my ($j, @msgs, $oldmsg, $amount, $space);
2166
2167 @msgs = split /\\n/, $msg;
2168 for ($j = 0; $j < @msgs; $j++) {
2169 my (@msg, $i);
2170
2171 @msg = split / /, $msgs[$j];
2172 undef $msg;
2173 for ($i = 0; $i < @msg; $i++) {
2174 if (!length($msg[$i])) {
2175 $msg[$i] = " ";
2176 $space = 1;
2177 }
2178 if (length($msg[$i]) > $config{'message_length_max'}) {
2179 while (length($msg[$i]) >= $config{'message_length_max'}) {
2180 $oldmsg = $msg;
2181 if (length($msg)) {
2182 $amount = $config{'message_length_max'};
2183 if ($amount - length($msg) > 0) {
2184 $amount = $config{'message_length_max'} - 1;
2185 $msg .= " " . substr($msg[$i], 0, $amount - length($msg));
2186 }
2187 } else {
2188 $amount = $config{'message_length_max'};
2189 $msg .= substr($msg[$i], 0, $amount);
2190 }
2191 sendMessage_send($sender, $type, $msg, $user);
2192 $msg[$i] = substr($msg[$i], $amount - length($oldmsg), length($msg[$i]) - $amount - length($oldmsg));
2193 undef $msg;
2194 }
2195 }
2196 if (length($msg[$i]) && length($msg) + length($msg[$i]) <= $config{'message_length_max'}) {
2197 if (length($msg)) {
2198 if (!$space) {
2199 $msg .= " " . $msg[$i];
2200 } else {
2201 $space = 0;
2202 $msg .= $msg[$i];
2203 }
2204 } else {
2205 $msg .= $msg[$i];
2206 }
2207 } else {
2208 sendMessage_send($sender, $type, $msg, $user);
2209 $msg = $msg[$i];
2210 }
2211 if (length($msg) && $i == @msg - 1) {
2212 sendMessage_send($sender, $type, $msg, $user);
2213 }
2214 }
2215 }
2216}
2217
2218sub sendMessage_send {
2219 my ($sender, $type, $msg, $user) = @_;
2220
2221 if ($type eq "c") {
2222 $sender->sendChat($msg);
2223 } elsif ($type eq "g") {
2224 $sender->sendGuildChat($msg);
2225 } elsif ($type eq "p") {
2226 $sender->sendPartyChat($msg);
2227 } elsif ($type eq "bg") {
2228 $sender->sendBattlegroundChat($msg);
2229 } elsif ($type eq "pm") {
2230 $sender->sendPrivateMsg($user, $msg);
2231 %lastpm = (
2232 msg => $msg,
2233 user => $user
2234 );
2235 push @lastpm, {%lastpm};
2236 } elsif ($type eq "k") {
2237 $sender->injectMessage($msg);
2238 }
2239}
2240
2241# Keep track of when we last cast a skill
2242sub setSkillUseTimer {
2243 my ($skillID, $targetID, $wait) = @_;
2244 my $skill = new Skill(idn => $skillID);
2245 my $handle = $skill->getHandle();
2246
2247 $char->{skills}{$handle}{time_used} = time;
2248 delete $char->{time_cast};
2249 delete $char->{cast_cancelled};
2250 $char->{last_skill_time} = time;
2251 $char->{last_skill_used} = $skillID;
2252 $char->{last_skill_target} = $targetID;
2253
2254 # increment monsterSkill maxUses counter
2255 if (defined $targetID) {
2256 my $actor = Actor::get($targetID);
2257 $actor->{skillUses}{$skill->getHandle()}++;
2258 }
2259
2260 # Set encore skill if applicable
2261 $char->{encoreSkill} = $skill if $targetID eq $accountID && $skillsEncore{$skill->getHandle()};
2262}
2263
2264sub setPartySkillTimer {
2265 my ($skillID, $targetID) = @_;
2266 my $skill = new Skill(idn => $skillID);
2267 my $handle = $skill->getHandle();
2268
2269 # set partySkill target_time
2270 my $i = $targetTimeout{$targetID}{$handle};
2271 $ai_v{"partySkill_${i}_target_time"}{$targetID} = time if $i ne "";
2272}
2273
2274
2275##
2276# boolean setStatus(Actor actor, opt1, opt2, option)
2277# opt1: the state information of the actor.
2278# opt2: the ailment information of the actor.
2279# option: the "look" information of the actor.
2280# Returns: Whether the actor should be removed from the actor list.
2281#
2282# Sets the state, ailment, and "look" statuses of the actor.
2283# Does not include skillsstatus.txt items.
2284# TODO: move to Actor?
2285sub setStatus {
2286 my ($actor, $opt1, $opt2, $option) = @_;
2287 assert(defined $actor) if DEBUG;
2288 assert(UNIVERSAL::isa($actor, 'Actor')) if DEBUG;
2289 my $verbosity = $actor->{ID} eq $accountID ? 1 : 2;
2290 my $changed = 0;
2291
2292 my $match_id = sub {return ($_[0] == $_[1])};
2293 my $match_bitflag = sub {return (($_[0] & $_[1]) == $_[1])};
2294
2295 # TODO: we could possibly make the search faster (binary search?)
2296 for (
2297 [$opt1, \%stateHandle, $match_id, 'state'],
2298 [$opt2, \%ailmentHandle, $match_bitflag, 'ailment'],
2299 [$option, \%lookHandle, $match_bitflag, 'look'],
2300 ) {
2301 my ($option, $handle, $match, $name) = @$_;
2302 #next unless $option; # skip option 0 (no state, ailment, look has such id or bitflag) (we can't have this, the state resets its statuses using this)
2303 for (keys %$handle) {
2304 if (&$match($option, $_)) {
2305 unless ($actor->{statuses}{$handle->{$_}}) {
2306 $actor->{statuses}{$handle->{$_}} = 1;
2307 message status_string($actor, $name . ': ' . ($statusName{$handle->{$_}} || $handle->{$_}), 'now'), "parseMsg_status$name", $verbosity;
2308 $changed = 1;
2309 }
2310 #last; # stop this for loop if found (we cannot do this because of bit flag match must loop all)
2311 } elsif ($actor->{statuses}{$handle->{$_}}) {
2312 delete $actor->{statuses}{$handle->{$_}};
2313 message status_string($actor, $name . ': ' . ($statusName{$handle->{$_}} || $handle->{$_}), 'no longer'), "parseMsg_status$name", $verbosity;
2314 $changed = 1;
2315 #last; # stop this for loop if found (we cannot do this because of bit flag match must loop all)
2316 }
2317 }
2318 }
2319=pod
2320 foreach (keys %stateHandle) {
2321 if ($opt1 == $_) {
2322 if (!$actor->{statuses}{$stateHandle{$_}}) {
2323 $actor->{statuses}{$stateHandle{$_}} = 1;
2324 message TF("%s %s in %s state.\n", $actor, $actor->verb('are', 'is'), $statusName{$stateHandle{$_}} || $stateHandle{$_}), "parseMsg_statuslook", $verbosity;
2325 $changed = 1;
2326 }
2327 } elsif ($actor->{statuses}{$stateHandle{$_}}) {
2328 delete $actor->{statuses}{$stateHandle{$_}};
2329 message TF("%s %s out of %s state.\n", $actor, $actor->verb('are', 'is'), $statusName{$stateHandle{$_}} || $stateHandle{$_}), "parseMsg_statuslook", $verbosity;
2330 $changed = 1;
2331 }
2332 }
2333
2334 foreach (keys %ailmentHandle) {
2335 if (($opt2 & $_) == $_) {
2336 if (!$actor->{statuses}{$ailmentHandle{$_}}) {
2337 $actor->{statuses}{$ailmentHandle{$_}} = 1;
2338 if ($actor->isa('Actor::You')) {
2339 message TF("%s have ailment: %s.\n", $actor->nameString(), $statusName{$ailmentHandle{$_}} || $ailmentHandle{$_}), "parseMsg_statuslook", $verbosity;
2340 } else {
2341 message TF("%s has ailment: %s.\n", $actor->nameString(), $statusName{$ailmentHandle{$_}} || $ailmentHandle{$_}), "parseMsg_statuslook", $verbosity;
2342 }
2343 $changed = 1;
2344 }
2345 } elsif ($actor->{statuses}{$ailmentHandle{$_}}) {
2346 delete $actor->{statuses}{$ailmentHandle{$_}};
2347 message TF("%s %s out of %s ailment.\n", $actor, $actor->verb('are', 'is'), $statusName{$ailmentHandle{$_}} || $ailmentHandle{$_}), "parseMsg_statuslook", $verbosity;
2348 $changed = 1;
2349 }
2350 }
2351
2352 foreach (keys %lookHandle) {
2353 if (($option & $_) == $_) {
2354 if (!$actor->{statuses}{$lookHandle{$_}}) {
2355 $actor->{statuses}{$lookHandle{$_}} = 1;
2356 if ($actor->isa('Actor::You')) {
2357 message TF("%s have look: %s.\n", $actor->nameString, $statusName{$lookHandle{$_}} || $lookHandle{$_}), "parseMsg_statuslook", $verbosity;
2358 } else {
2359 message TF("%s has look: %s.\n", $actor->nameString, $statusName{$lookHandle{$_}} || $lookHandle{$_}), "parseMsg_statuslook", $verbosity;
2360 }
2361 $changed = 1;
2362 }
2363 } elsif ($actor->{statuses}{$lookHandle{$_}}) {
2364 delete $actor->{statuses}{$lookHandle{$_}};
2365 message TF("%s %s out of %s look.\n", $actor, $actor->verb('are', 'is'), $statusName{$lookHandle{$_}} || $lookHandle{$_}), "parseMsg_statuslook", $verbosity;
2366 $changed = 1;
2367 }
2368 }
2369=cut
2370 Plugins::callHook('changed_status',{actor => $actor, changed => $changed});
2371
2372 # Remove perfectly hidden objects
2373 if ($actor->statusActive('EFFECTSTATE_SPECIALHIDING')) {
2374 if (UNIVERSAL::isa($actor, "Actor::Player")) {
2375 message TF("Found perfectly hidden %s\n", $actor->nameString());
2376 # message TF("Remove perfectly hidden %s\n", $actor->nameString());
2377 # $playersList->remove($actor);
2378 # Call the hook when a perfectly hidden player is detected
2379 # Plugins::callHook('perfect_hidden_player',undef);
2380 Plugins::callHook('perfect_hidden_player',{actor => $actor, changed => $changed});
2381
2382 } elsif (UNIVERSAL::isa($actor, "Actor::Monster")) {
2383 message TF("Found perfectly hidden %s\n", $actor->nameString());
2384 # message TF("Remove perfectly hidden %s\n", $actor->nameString());
2385 # $monstersList->remove($actor);
2386
2387 # NPCs do this on purpose (who knows why)
2388 } elsif (UNIVERSAL::isa($actor, "Actor::NPC")) {
2389 message TF("Found perfectly hidden %s\n", $actor->nameString());
2390 # message TF("Remove perfectly hidden %s\n", $actor->nameString());
2391 # $npcsList->remove($actor);
2392
2393 } elsif (UNIVERSAL::isa($actor, "Actor::Pet")) {
2394 message TF("Found perfectly hidden %s\n", $actor->nameString());
2395 # message TF("Remove perfectly hidden %s\n", $actor->nameString());
2396 # $petsList->remove($actor);
2397 }
2398 return 1;
2399 } else {
2400 return 0;
2401 }
2402}
2403
2404
2405# Increment counter for monster being casted on
2406sub countCastOn {
2407 my ($sourceID, $targetID, $skillID, $x, $y) = @_;
2408 return unless defined $targetID;
2409
2410 my $source = Actor::get($sourceID);
2411 my $target = Actor::get($targetID);
2412 assert(UNIVERSAL::isa($source, 'Actor')) if DEBUG;
2413 assert(UNIVERSAL::isa($target, 'Actor')) if DEBUG;
2414
2415 if ($targetID eq $accountID) {
2416 $source->{castOnToYou}++;
2417 } elsif ($target->isa('Actor::Player')) {
2418 $source->{castOnToPlayer}{$targetID}++;
2419 } elsif ($target->isa('Actor::Monster')) {
2420 $source->{castOnToMonster}{$targetID}++;
2421 }
2422
2423 if ($sourceID eq $accountID) {
2424 $target->{castOnByYou}++;
2425 } elsif ($source->isa('Actor::Player')) {
2426 $target->{castOnByPlayer}{$sourceID}++;
2427 } elsif ($source->isa('Actor::Monster')) {
2428 $target->{castOnByMonster}{$sourceID}++;
2429 }
2430}
2431
2432##
2433# boolean stripLanguageCode(String* msg)
2434# msg: a chat message, as sent by the RO server.
2435# Returns: whether the language code was stripped.
2436#
2437# Strip the language code character from a chat message.
2438sub stripLanguageCode {
2439 my $r_msg = shift;
2440 if ($config{chatLangCode} && $config{chatLangCode} ne "none") {
2441 if ($$r_msg =~ /^\|..(.*)/) {
2442 $$r_msg = $1;
2443 return 1;
2444 }
2445 return 0;
2446 } else {
2447 return 0;
2448 }
2449}
2450
2451##
2452# void switchConf(String filename)
2453# filename: a configuration file.
2454# Returns: 1 on success, 0 if $filename does not exist.
2455#
2456# Switch to another configuration file.
2457sub switchConfigFile {
2458 my $filename = shift;
2459 if (! -f $filename) {
2460 error TF("%s does not exist.\n", $filename);
2461 return 0;
2462 }
2463
2464 Settings::setConfigFilename($filename);
2465 parseConfigFile($filename, \%config);
2466 return 1;
2467}
2468
2469sub updateDamageTables {
2470 my ($sourceID, $targetID, $damage) = @_;
2471
2472 # Track deltaHp
2473 #
2474 # A player's "deltaHp" initially starts at 0.
2475 # When he takes damage, the damage is subtracted from his deltaHp.
2476 # When he is healed, this amount is added to the deltaHp.
2477 # If the deltaHp becomes positive, it is reset to 0.
2478 #
2479 # Someone with a lot of negative deltaHp is probably in need of healing.
2480 # This allows us to intelligently heal non-party members.
2481 if (my $target = Actor::get($targetID)) {
2482 $target->{deltaHp} -= $damage;
2483 $target->{deltaHp} = 0 if $target->{deltaHp} > 0;
2484 }
2485
2486 if ($sourceID eq $accountID) {
2487 if ((my $monster = $monstersList->getByID($targetID))) {
2488 # You attack monster
2489 $monster->{dmgTo} += $damage;
2490 $monster->{dmgFromYou} += $damage;
2491 $monster->{numAtkFromYou}++;
2492 if ($damage <= ($config{missDamage} || 0)) {
2493 $monster->{missedFromYou}++;
2494 debug "Incremented missedFromYou count to $monster->{missedFromYou}\n", "attackMonMiss";
2495 $monster->{atkMiss}++;
2496 } else {
2497 $monster->{atkMiss} = 0;
2498 }
2499 if ($config{teleportAuto_atkMiss} && $monster->{atkMiss} >= $config{teleportAuto_atkMiss}) {
2500 message T("Teleporting because of attack miss\n"), "teleport";
2501 useTeleport(1);
2502 }
2503 if ($config{teleportAuto_atkCount} && $monster->{numAtkFromYou} >= $config{teleportAuto_atkCount}) {
2504 message TF("Teleporting after attacking a monster %d times\n", $config{teleportAuto_atkCount}), "teleport";
2505 useTeleport(1);
2506 }
2507
2508 if (AI::action eq "attack" && mon_control($monster->{name},$monster->{nameID})->{attack_auto} == 3 && $damage) {
2509 # Mob-training, you only need to attack the monster once to provoke it
2510 message TF("%s (%s) has been provoked, searching another monster\n", $monster->{name}, $monster->{binID});
2511 $char->sendAttackStop;
2512 $char->dequeue;
2513 }
2514
2515
2516 }
2517
2518=pod
2519 } elsif ($targetID eq $accountID) {
2520 if ((my $monster = $monstersList->getByID($sourceID))) {
2521 # Monster attacks you
2522 $monster->{dmgFrom} += $damage;
2523 $monster->{dmgToYou} += $damage;
2524 if ($damage == 0) {
2525 $monster->{missedYou}++;
2526 }
2527 $monster->{attackedYou}++ unless (
2528 scalar(keys %{$monster->{dmgFromPlayer}}) ||
2529 scalar(keys %{$monster->{dmgToPlayer}}) ||
2530 $monster->{missedFromPlayer} ||
2531 $monster->{missedToPlayer}
2532 );
2533 $monster->{target} = $targetID;
2534
2535 if ($AI == 2) {
2536 my $teleport = 0;
2537 if (mon_control($monster->{name},$monster->{nameID})->{teleport_auto} == 2 && $damage){
2538 message TF("Teleporting due to attack from %s\n",
2539 $monster->{name}), "teleport";
2540 $teleport = 1;
2541
2542 } elsif ($config{teleportAuto_deadly} && $damage >= $char->{hp}
2543 && !$char->statusActive('EFST_ILLUSION')) {
2544 message TF("Next %d dmg could kill you. Teleporting...\n",
2545 $damage), "teleport";
2546 $teleport = 1;
2547
2548 } elsif ($config{teleportAuto_maxDmg} && $damage >= $config{teleportAuto_maxDmg}
2549 && !$char->statusActive('EFST_ILLUSION')
2550 && !($config{teleportAuto_maxDmgInLock} && $field->baseName eq $config{lockMap})) {
2551 message TF("%s hit you for more than %d dmg. Teleporting...\n",
2552 $monster->{name}, $config{teleportAuto_maxDmg}), "teleport";
2553 $teleport = 1;
2554
2555 } elsif ($config{teleportAuto_maxDmgInLock} && $field->baseName eq $config{lockMap}
2556 && $damage >= $config{teleportAuto_maxDmgInLock}
2557 && !$char->statusActive('EFST_ILLUSION')) {
2558 message TF("%s hit you for more than %d dmg in lockMap. Teleporting...\n",
2559 $monster->{name}, $config{teleportAuto_maxDmgInLock}), "teleport";
2560 $teleport = 1;
2561
2562 } elsif (AI::inQueue("sitAuto") && $config{teleportAuto_attackedWhenSitting}
2563 && $damage > 0) {
2564 message TF("%s attacks you while you are sitting. Teleporting...\n",
2565 $monster->{name}), "teleport";
2566 $teleport = 1;
2567
2568 } elsif ($config{teleportAuto_totalDmg}
2569 && $monster->{dmgToYou} >= $config{teleportAuto_totalDmg}
2570 && !$char->statusActive('EFST_ILLUSION')
2571 && !($config{teleportAuto_totalDmgInLock} && $field->baseName eq $config{lockMap})) {
2572 message TF("%s hit you for a total of more than %d dmg. Teleporting...\n",
2573 $monster->{name}, $config{teleportAuto_totalDmg}), "teleport";
2574 $teleport = 1;
2575
2576 } elsif ($config{teleportAuto_totalDmgInLock} && $field->baseName eq $config{lockMap}
2577 && $monster->{dmgToYou} >= $config{teleportAuto_totalDmgInLock}
2578 && !$char->statusActive('EFST_ILLUSION')) {
2579 message TF("%s hit you for a total of more than %d dmg in lockMap. Teleporting...\n",
2580 $monster->{name}, $config{teleportAuto_totalDmgInLock}), "teleport";
2581 $teleport = 1;
2582
2583 } elsif ($config{teleportAuto_hp} && percent_hp($char) <= $config{teleportAuto_hp}) {
2584 message TF("%s hit you when your HP is too low. Teleporting...\n",
2585 $monster->{name}), "teleport";
2586 $teleport = 1;
2587
2588 } elsif ($config{attackChangeTarget} && ((AI::action eq "route" && AI::action(1) eq "attack") || (AI::action eq "move" && AI::action(2) eq "attack"))
2589 && AI::args->{attackID} && AI::args()->{attackID} ne $sourceID) {
2590 my $attackTarget = Actor::get(AI::args->{attackID});
2591 my $attackSeq = (AI::action eq "route") ? AI::args(1) : AI::args(2);
2592 if (!$attackTarget->{dmgToYou} && !$attackTarget->{dmgFromYou} && distance($monster->{pos_to}, calcPosition($char)) <= $attackSeq->{attackMethod}{distance}) {
2593 my $ignore = 0;
2594 # Don't attack ignored monsters
2595 if ((my $control = mon_control($monster->{name},$monster->{nameID}))) {
2596 $ignore = 1 if ( ($control->{attack_auto} == -1)
2597 || ($control->{attack_lvl} ne "" && $control->{attack_lvl} > $char->{lv})
2598 || ($control->{attack_jlvl} ne "" && $control->{attack_jlvl} > $char->{lv_job})
2599 || ($control->{attack_hp} ne "" && $control->{attack_hp} > $char->{hp})
2600 || ($control->{attack_sp} ne "" && $control->{attack_sp} > $char->{sp})
2601 || ($control->{attack_auto} == 3 && ($monster->{dmgToYou} || $monster->{missedYou} || $monster->{dmgFromYou}))
2602 );
2603 }
2604 if (!$ignore) {
2605 # Change target to closer aggressive monster
2606 message TF("Change target to aggressive : %s (%s)\n", $monster->name, $monster->{binID});
2607 stopAttack();
2608 AI::dequeue;
2609 AI::dequeue if (AI::action eq "route");
2610 AI::dequeue;
2611 attack($sourceID);
2612 }
2613 }
2614
2615 } elsif (AI::action eq "attack" && mon_control($monster->{name},$monster->{nameID})->{attack_auto} == 3
2616 && ($monster->{dmgToYou} || $monster->{missedYou} || $monster->{dmgFromYou})) {
2617
2618 # Mob-training, stop attacking the monster if it has been attacking you
2619 message TF("%s (%s) has been provoked, searching another monster\n", $monster->{name}, $monster->{binID});
2620 stopAttack();
2621 AI::dequeue();
2622 }
2623
2624 useTeleport(1, undef, 1) if ($teleport);
2625 }
2626 }
2627=cut
2628
2629 } elsif ((my $monster = $monstersList->getByID($sourceID))) {
2630 if (my $player = ($accountID eq $targetID && $char) || $playersList->getByID($targetID) || $slavesList->getByID($targetID)) {
2631 # Monster attacks player or slave
2632 $monster->{dmgFrom} += $damage;
2633 ($accountID eq $targetID ? $monster->{dmgToYou} : $monster->{dmgToPlayer}{$targetID}) += $damage;
2634 $player->{dmgFromMonster}{$sourceID} += $damage;
2635 if ($damage == 0) {
2636 ($accountID eq $targetID ? $monster->{missedYou} : $monster->{missedToPlayer}{$targetID}) += 1;
2637 $player->{missedFromMonster}{$sourceID}++;
2638 }
2639 $accountID eq $targetID && $monster->{attackedYou}++ unless (
2640 scalar(keys %{$monster->{dmgFromPlayer}}) ||
2641 scalar(keys %{$monster->{dmgToPlayer}}) ||
2642 $monster->{missedFromPlayer} ||
2643 $monster->{missedToPlayer}
2644 );
2645 if (existsInList($config{tankersList}, $player->{name}) ||
2646 ($char->{slaves} && %{$char->{slaves}} && $char->{slaves}{$targetID} && %{$char->{slaves}{$targetID}}) ||
2647 ($char->{party} && %{$char->{party}} && $char->{party}{users}{$targetID} && %{$char->{party}{users}{$targetID}})) {
2648 # Monster attacks party member or our slave
2649 $monster->{dmgToParty} += $damage;
2650 $monster->{missedToParty}++ if ($damage == 0);
2651 }
2652 $monster->{target} = $targetID;
2653 OpenKoreMod::updateDamageTables($monster) if (defined &OpenKoreMod::updateDamageTables);
2654
2655 if ($AI == AI::AUTO && ($accountID eq $targetID or $char->{slaves} && $char->{slaves}{$targetID})) {
2656 # object under our control
2657 my $teleport = 0;
2658 if (mon_control($monster->{name},$monster->{nameID})->{teleport_auto} == 2 && $damage){
2659 message TF("%s hit %s. Teleporting...\n",
2660 $monster, $player), "teleport";
2661 $teleport = 1;
2662
2663 } elsif ($config{$player->{configPrefix}.'teleportAuto_deadly'} && $damage >= $player->{hp}
2664 && !$player->statusActive('EFST_ILLUSION')) {
2665 message TF("%s can kill %s with the next %d dmg. Teleporting...\n",
2666 $monster, $player, $damage), "teleport";
2667 $teleport = 1;
2668
2669 } elsif ($config{$player->{configPrefix}.'teleportAuto_maxDmg'} && $damage >= $config{$player->{configPrefix}.'teleportAuto_maxDmg'}
2670 && !$player->statusActive('EFST_ILLUSION')
2671 && !($config{$player->{configPrefix}.'teleportAuto_maxDmgInLock'} && $field->baseName eq $config{lockMap})) {
2672 message TF("%s hit %s for more than %d dmg. Teleporting...\n",
2673 $monster, $player, $config{$player->{configPrefix}.'teleportAuto_maxDmg'}), "teleport";
2674 $teleport = 1;
2675
2676 } elsif ($config{$player->{configPrefix}.'teleportAuto_maxDmgInLock'} && $field->baseName eq $config{lockMap}
2677 && $damage >= $config{$player->{configPrefix}.'teleportAuto_maxDmgInLock'}
2678 && !$player->statusActive('EFST_ILLUSION')) {
2679 message TF("%s hit %s for more than %d dmg in lockMap. Teleporting...\n",
2680 $monster, $player, $config{$player->{configPrefix}.'teleportAuto_maxDmgInLock'}), "teleport";
2681 $teleport = 1;
2682
2683 } elsif (AI::inQueue("sitAuto") && $config{$player->{configPrefix}.'teleportAuto_attackedWhenSitting'}
2684 && $damage) {
2685 message TF("%s hit %s while you are sitting. Teleporting...\n",
2686 $monster, $player), "teleport";
2687 $teleport = 1;
2688
2689 } elsif ($config{$player->{configPrefix}.'teleportAuto_totalDmg'}
2690 && ($accountID eq $targetID ? $monster->{dmgToYou} : $monster->{dmgToPlayer}{$targetID}) >= $config{$player->{configPrefix}.'teleportAuto_totalDmg'}
2691 && !$player->statusActive('EFST_ILLUSION')
2692 && !($config{$player->{configPrefix}.'teleportAuto_totalDmgInLock'} && $field->baseName eq $config{lockMap})) {
2693 message TF("%s hit %s for a total of more than %d dmg. Teleporting...\n",
2694 $monster, $player, $config{$player->{configPrefix}.'teleportAuto_totalDmg'}), "teleport";
2695 $teleport = 1;
2696
2697 } elsif ($config{$player->{configPrefix}.'teleportAuto_totalDmgInLock'} && $field->baseName eq $config{lockMap}
2698 && ($accountID eq $targetID ? $monster->{dmgToYou} : $monster->{dmgToPlayer}{$targetID}) >= $config{$player->{configPrefix}.'teleportAuto_totalDmgInLock'}
2699 && !$player->statusActive('EFST_ILLUSION')) {
2700 message TF("%s hit %s for a total of more than %d dmg in lockMap. Teleporting...\n",
2701 $monster, $player, $config{$player->{configPrefix}.'teleportAuto_totalDmgInLock'}), "teleport";
2702 $teleport = 1;
2703
2704 } elsif ($config{$player->{configPrefix}.'teleportAuto_hp'} && percent_hp($player) <= $config{$player->{configPrefix}.'teleportAuto_hp'}) {
2705 message TF("%s hit %s when %s HP is under %d. Teleporting...\n",
2706 $monster, $player, $player->verb(T('your'), T('its')), $config{$player->{configPrefix}.'teleportAuto_hp'}), "teleport";
2707 $teleport = 1;
2708
2709 } elsif (
2710 $config{$player->{configPrefix}.'attackChangeTarget'}
2711 && (
2712 $player->action eq 'route' && $player->action(1) eq 'attack'
2713 or $player->action eq 'move' && $player->action(2) eq 'attack'
2714 )
2715 && $player->args->{attackID} && $player->args->{attackID} ne $sourceID
2716 ) {
2717 my $attackTarget = Actor::get($player->args->{attackID});
2718 my $attackSeq = ($player->action eq 'route') ? $player->args(1) : $player->args(2);
2719 if (
2720 !($accountID eq $targetID ? $attackTarget->{dmgToYou} : $attackTarget->{dmgToPlayer}{$targetID})
2721 && !($accountID eq $targetID ? $attackTarget->{dmgToYou} : $attackTarget->{dmgFromPlayer}{$targetID})
2722 && distance($monster->{pos_to}, calcPosition($player)) <= $attackSeq->{attackMethod}{distance}
2723 ) {
2724 my $ignore = 0;
2725 # Don't attack ignored monsters
2726 if ((my $control = mon_control($monster->{name},$monster->{nameID}))) {
2727 $ignore = 1 if ( ($control->{attack_auto} == -1)
2728 || ($control->{attack_lvl} ne "" && $control->{attack_lvl} > $char->{lv})
2729 || ($control->{attack_jlvl} ne "" && $control->{attack_jlvl} > $char->{lv_job})
2730 || ($control->{attack_hp} ne "" && $control->{attack_hp} > $char->{hp})
2731 || ($control->{attack_sp} ne "" && $control->{attack_sp} > $char->{sp})
2732 || ($accountID eq $targetID && $control->{attack_auto} == 3 && ($monster->{dmgToYou} || $monster->{missedYou} || $monster->{dmgFromYou}))
2733 );
2734 }
2735 unless ($ignore) {
2736 # Change target to closer aggressive monster
2737 message TF("%s %s target to aggressive %s\n",
2738 $player, $player->verb(T('change'), T('changes')), $monster);
2739 $player->sendAttackStop;
2740 $player->dequeue;
2741 $player->dequeue if $player->action eq 'route';
2742 $player->dequeue;
2743 $player->attack($sourceID);
2744 }
2745 }
2746
2747 } elsif ($accountID eq $targetID && $player->action eq "attack" && mon_control($monster->{name}, $monster->{nameID})->{attack_auto} == 3
2748 && ($monster->{dmgToYou} || $monster->{missedYou} || $monster->{dmgFromYou})) {
2749
2750 # Mob-training, stop attacking the monster if it has been attacking you
2751 message TF("%s has been provoked, searching another monster\n", $monster);
2752 $player->sendAttackStop;
2753 $player->dequeue;
2754 }
2755 useTeleport(1, undef, 1) if ($teleport);
2756 }
2757 }
2758
2759 } elsif ((my $player = $playersList->getByID($sourceID) || $slavesList->getByID($sourceID))) {
2760 if ((my $monster = $monstersList->getByID($targetID))) {
2761 # Player or Slave attacks monster
2762 $monster->{dmgTo} += $damage;
2763 $monster->{dmgFromPlayer}{$sourceID} += $damage;
2764 $monster->{lastAttackFrom} = $sourceID;
2765 $player->{dmgToMonster}{$targetID} += $damage;
2766
2767 if ($damage == 0) {
2768 $monster->{missedFromPlayer}{$sourceID}++;
2769 $player->{missedToMonster}{$targetID}++;
2770 }
2771
2772 if (existsInList($config{tankersList}, $player->{name}) || ($char->{slaves} && $char->{slaves}{$sourceID}) ||
2773 ($char->{party} && %{$char->{party}} && $char->{party}{users}{$sourceID} && %{$char->{party}{users}{$sourceID}})) {
2774 $monster->{dmgFromParty} += $damage;
2775
2776 if ($damage == 0) {
2777 $monster->{missedFromParty}++;
2778 }
2779 }
2780 OpenKoreMod::updateDamageTables($monster) if (defined &OpenKoreMod::updateDamageTables);
2781 }
2782 }
2783}
2784
2785##
2786# updatePlayerNameCache(player)
2787# player: a player actor object.
2788sub updatePlayerNameCache {
2789 my ($player) = @_;
2790
2791 return if (!$config{cachePlayerNames});
2792
2793 # First, cleanup the cache. Remove entries that are too old.
2794 # Default life time: 15 minutes
2795 my $changed = 1;
2796 for (my $i = 0; $i < @playerNameCacheIDs; $i++) {
2797 my $ID = $playerNameCacheIDs[$i];
2798 if (timeOut($playerNameCache{$ID}{time}, $config{cachePlayerNames_duration})) {
2799 delete $playerNameCacheIDs[$i];
2800 delete $playerNameCache{$ID};
2801 $changed = 1;
2802 }
2803 }
2804 compactArray(\@playerNameCacheIDs) if ($changed);
2805
2806 # Resize the cache if it's still too large.
2807 # Default cache size: 100
2808 while (@playerNameCacheIDs > $config{cachePlayerNames_maxSize}) {
2809 my $ID = shift @playerNameCacheIDs;
2810 delete $playerNameCache{$ID};
2811 }
2812
2813 # Add this player name to the cache.
2814 my $ID = $player->{ID};
2815 if (!$playerNameCache{$ID}) {
2816 push @playerNameCacheIDs, $ID;
2817 my %entry = (
2818 name => $player->{name},
2819 guild => $player->{guild},
2820 time => time,
2821 lv => $player->{lv},
2822 jobID => $player->{jobID}
2823 );
2824 $playerNameCache{$ID} = \%entry;
2825 }
2826}
2827
2828##
2829# useTeleport(level)
2830# level: 1 to teleport to a random spot, 2 to respawn.
2831sub useTeleport {
2832 my ($use_lvl, $internal, $emergency) = @_;
2833
2834 my %args = (
2835 level => $use_lvl, # 1 = Teleport, 2 = respawn
2836 emergency => $emergency, # Needs a fast tele
2837 internal => $internal # Did we call useTeleport from inside useTeleport?
2838 );
2839
2840 if ($use_lvl == 2 && $config{saveMap_warpChatCommand}) {
2841 Plugins::callHook('teleport_sent', \%args);
2842 sendMessage($messageSender, "c", $config{saveMap_warpChatCommand});
2843 return 1;
2844 }
2845
2846 if ($use_lvl == 1 && $config{teleportAuto_useChatCommand}) {
2847 Plugins::callHook('teleport_sent', \%args);
2848 sendMessage($messageSender, "c", $config{teleportAuto_useChatCommand});
2849 return 1;
2850 }
2851
2852 # for possible recursive calls
2853 if (!defined $internal) {
2854 $internal = $config{teleportAuto_useSkill};
2855 }
2856
2857 # look if the character has the skill
2858 my $sk_lvl = 0;
2859 if ($char->{skills}{AL_TELEPORT}) {
2860 $sk_lvl = $char->{skills}{AL_TELEPORT}{lv};
2861 }
2862
2863 # only if we want to use skill ?
2864 return if ($char->{muted});
2865
2866 if ($sk_lvl > 0 && $internal > 0 && ($use_lvl == 1 || !$config{'teleportAuto_useItemForRespawn'})) {
2867 # We have the teleport skill, and should use it
2868 my $skill = new Skill(handle => 'AL_TELEPORT');
2869 if ($use_lvl == 2 || $internal == 1 || ($internal == 2 && !isSafe())) {
2870 # Send skill use packet to appear legitimate
2871 # (Always send skill use packet for level 2 so that saveMap
2872 # autodetection works)
2873
2874 if ($char->{sitting}) {
2875 Plugins::callHook('teleport_sent', \%args);
2876 main::ai_skillUse($skill->getHandle(), $use_lvl, 0, 0, $accountID);
2877 return 1;
2878 } else {
2879 $messageSender->sendSkillUse($skill->getIDN(), $sk_lvl, $accountID);
2880 undef $char->{permitSkill};
2881 }
2882
2883 if (!$emergency && $use_lvl == 1) {
2884 Plugins::callHook('teleport_sent', \%args);
2885 $timeout{ai_teleport_retry}{time} = time;
2886 AI::queue('teleport');
2887 return 1;
2888 }
2889 }
2890
2891 delete $ai_v{temp}{teleport};
2892 debug "Sending Teleport using Level $use_lvl\n", "useTeleport";
2893 if ($use_lvl == 1) {
2894 Plugins::callHook('teleport_sent', \%args);
2895 $messageSender->sendWarpTele(26, "Random");
2896 return 1;
2897 } elsif ($use_lvl == 2) {
2898 # check for possible skill level abuse
2899 message T("Using Teleport Skill Level 2 though we not have it!\n"), "useTeleport" if ($sk_lvl == 1);
2900
2901 # If saveMap is not set simply use a wrong .gat.
2902 # eAthena servers ignore it, but this trick doesn't work
2903 # on official servers.
2904 my $telemap = "prontera.gat";
2905 $telemap = "$config{saveMap}.gat" if ($config{saveMap} ne "");
2906 Plugins::callHook('teleport_sent', \%args);
2907 $messageSender->sendWarpTele(26, $telemap);
2908 return 1;
2909 }
2910 }
2911
2912 # No skill try to equip a Tele clip or something,
2913 # if teleportAuto_equip_* is set
2914 if (Actor::Item::scanConfigAndCheck('teleportAuto_equip') && ($use_lvl == 1 || !$config{'teleportAuto_useItemForRespawn'})) {
2915 return if AI::inQueue('teleport');
2916 debug "Equipping Accessory to teleport\n", "useTeleport";
2917 AI::queue('teleport', {lv => $use_lvl});
2918 if ($emergency ||
2919 !$config{teleportAuto_useSkill} ||
2920 $config{teleportAuto_useSkill} == 3 ||
2921 $config{teleportAuto_useSkill} == 2 && isSafe()) {
2922 $timeout{ai_teleport_delay}{time} = 1;
2923 }
2924 Actor::Item::scanConfigAndEquip('teleportAuto_equip');
2925 #Commands::run('aiv');
2926 return 1;
2927 }
2928
2929 # else if $internal == 0 or $sk_lvl == 0
2930 # try to use item
2931
2932 # could lead to problems if the ItemID would be different on some servers
2933 # 1 Jan 2006 - instead of nameID, search for *wing in the inventory
2934 # could lead to problems if the name is different on some servers
2935 # 11 Mar 2010 - instead of name, use nameID, names can be different for different servers
2936 my $item;
2937 if ($use_lvl == 1) {
2938 #$item = $char->inventory->getByName("Fly Wing");
2939 $item = $char->inventory->getByNameID(601);
2940 } elsif ($use_lvl == 2) {
2941 #$item = $char->inventory->getByName("Butterfly Wing");
2942 $item = $char->inventory->getByNameID(602);
2943 }
2944
2945 if ($item) {
2946 # We have Fly Wing/Butterfly Wing.
2947 # Don't spam the "use fly wing" packet, or we'll end up using too many wings.
2948 if (timeOut($timeout{ai_teleport})) {
2949 Plugins::callHook('teleport_sent', \%args);
2950 $messageSender->sendItemUse($item->{index}, $accountID);
2951 $timeout{ai_teleport}{time} = time;
2952 }
2953 return 1;
2954 }
2955
2956 # no item, but skill is still available
2957 if ( $sk_lvl > 0 ) {
2958 message T("No Fly Wing or Butterfly Wing, fallback to Teleport Skill\n"), "useTeleport";
2959 return useTeleport($use_lvl, 1, $emergency);
2960 }
2961
2962 if ($use_lvl == 1) {
2963 message T("You don't have the Teleport skill or a Fly Wing\n"), "teleport";
2964 } else {
2965 message T("You don't have the Teleport skill or a Butterfly Wing\n"), "teleport";
2966 }
2967
2968 return 0;
2969}
2970
2971##
2972# top10Listing(args)
2973# args: a 282 bytes packet representing 10 names followed by 10 ranks
2974#
2975# Returns a formatted list of [# ], Name and points
2976sub top10Listing {
2977 my ($args) = @_;
2978
2979 my $msg = $args->{RAW_MSG};
2980
2981 my @list;
2982 my @points;
2983 my $i;
2984 my $textList = "";
2985 for ($i = 0; $i < 10; $i++) {
2986 $list[$i] = unpack("Z24", substr($msg, 2 + (24*$i), 24));
2987 }
2988 for ($i = 0; $i < 10; $i++) {
2989 $points[$i] = unpack("V1", substr($msg, 242 + ($i*4), 4));
2990 }
2991 for ($i = 0; $i < 10; $i++) {
2992 $textList .= swrite("[@<] @<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>",
2993 [$i+1, $list[$i], $points[$i]]);
2994 }
2995
2996 return $textList;
2997}
2998
2999##
3000# whenGroundStatus(target, statuses, mine)
3001# target: coordinates hash
3002# statuses: a comma-separated list of ground effects e.g. Safety Wall,Pneuma
3003# mine: if true, only consider ground effects that originated from me
3004#
3005# Returns 1 if $target has one of the ground effects specified by $statuses.
3006sub whenGroundStatus {
3007 my ($pos, $statuses, $mine) = @_;
3008
3009 my ($x, $y) = ($pos->{x}, $pos->{y});
3010 for my $ID (@spellsID) {
3011 my $spell;
3012 next unless $spell = $spells{$ID};
3013 next if $mine && $spell->{sourceID} ne $accountID;
3014 if ($x == $spell->{pos}{x} &&
3015 $y == $spell->{pos}{y}) {
3016 return 1 if existsInList($statuses, getSpellName($spell->{type}));
3017 }
3018 }
3019 return 0;
3020}
3021
3022sub writeStorageLog {
3023 my ($show_error_on_fail) = @_;
3024 my $f;
3025
3026 if (open($f, ">:utf8", $Settings::storage_log_file)) {
3027 print $f TF("---------- Storage %s -----------\n", getFormattedDate(int(time)));
3028 for (my $i = 0; $i < @storageID; $i++) {
3029 next if (!$storageID[$i]);
3030 my $item = $storage{$storageID[$i]};
3031
3032 my $display = sprintf "%2d %s x %s", $i, $item->{name}, $item->{amount};
3033 # Translation Comment: Mark to show not identified items
3034 $display .= " -- " . T("Not Identified") if !$item->{identified};
3035 # Translation Comment: Mark to show broken items
3036 $display .= " -- " . T("Broken") if $item->{broken};
3037 print $f "$display\n";
3038 }
3039 # Translation Comment: Storage Capacity
3040 print $f TF("\nCapacity: %d/%d\n", $storage{items}, $storage{items_max});
3041 print $f "-------------------------------\n";
3042 close $f;
3043
3044 message T("Storage logged\n"), "success";
3045
3046 } elsif ($show_error_on_fail) {
3047 error TF("Unable to write to %s\n", $Settings::storage_log_file);
3048 }
3049}
3050
3051##
3052# getBestTarget(possibleTargets, nonLOSNotAllowed)
3053# possibleTargets: reference to an array of monsters' IDs
3054# nonLOSNotAllowed: if set, non-LOS monsters (and monsters that aren't in attackMaxDistance) aren't checked up
3055#
3056# Returns ID of the best target
3057sub getBestTarget {
3058 my ($possibleTargets, $nonLOSNotAllowed) = @_;
3059 if (!$possibleTargets) {
3060 return;
3061 }
3062
3063 my $portalDist = $config{'attackMinPortalDistance'} || 4;
3064 my $playerDist = $config{'attackMinPlayerDistance'} || 1;
3065
3066 my @noLOSMonsters;
3067 my $myPos = calcPosition($char);
3068 my ($highestPri, $smallestDist, $bestTarget);
3069
3070 # First of all we check monsters in LOS, then the rest of monsters
3071
3072 foreach (@{$possibleTargets}) {
3073 my $monster = $monsters{$_};
3074 my $pos = calcPosition($monster);
3075 next if (positionNearPlayer($pos, $playerDist)
3076 || positionNearPortal($pos, $portalDist)
3077 );
3078 if ((my $control = mon_control($monster->{name},$monster->{nameID}))) {
3079 next if ( ($control->{attack_auto} == -1)
3080 || ($control->{attack_lvl} ne "" && $control->{attack_lvl} > $char->{lv})
3081 || ($control->{attack_jlvl} ne "" && $control->{attack_jlvl} > $char->{lv_job})
3082 || ($control->{attack_hp} ne "" && $control->{attack_hp} > $char->{hp})
3083 || ($control->{attack_sp} ne "" && $control->{attack_sp} > $char->{sp})
3084 || ($control->{attack_auto} == 3 && ($monster->{dmgToYou} || $monster->{missedYou} || $monster->{dmgFromYou}))
3085 || ($control->{attack_auto} == 0 && !($monster->{dmgToYou} || $monster->{missedYou}))
3086 );
3087 }
3088 if ($config{'attackCanSnipe'}) {
3089 if (!checkLineSnipable($myPos, $pos)) {
3090 push(@noLOSMonsters, $_);
3091 next;
3092 }
3093 } else {
3094 if (!checkLineWalkable($myPos, $pos)) {
3095 push(@noLOSMonsters, $_);
3096 next;
3097 }
3098 }
3099 my $name = lc $monster->{name};
3100 my $dist = round(distance($myPos, $pos));
3101
3102 # COMMENTED (FIX THIS): attackMaxDistance should never be used as indication of LOS
3103 # The objective of attackMaxDistance is to determine the range of normal attack,
3104 # and not the range of character's ability to engage monsters
3105 ## Monsters that aren't in attackMaxDistance are not checked up
3106 ##if ($nonLOSNotAllowed && ($config{'attackMaxDistance'} < $dist)) {
3107 ## next;
3108 ##}
3109 if (!defined($highestPri) || ($priority{$name} > $highestPri)) {
3110 $highestPri = $priority{$name};
3111 $smallestDist = $dist;
3112 $bestTarget = $_;
3113 }
3114 if ((!defined($highestPri) || $priority{$name} == $highestPri)
3115 && (!defined($smallestDist) || $dist < $smallestDist)) {
3116 $highestPri = $priority{$name};
3117 $smallestDist = $dist;
3118 $bestTarget = $_;
3119 }
3120 }
3121 if (!$nonLOSNotAllowed && !$bestTarget && scalar(@noLOSMonsters) > 0) {
3122 foreach (@noLOSMonsters) {
3123 # The most optimal solution is to include the path lenghts' comparison, however it will take
3124 # more time and CPU resources, so, we use rough solution with priority and distance comparison
3125
3126 my $monster = $monsters{$_};
3127 my $pos = calcPosition($monster);
3128 my $name = lc $monster->{name};
3129 my $dist = round(distance($myPos, $pos));
3130 if (!defined($highestPri) || ($priority{$name} > $highestPri)) {
3131 $highestPri = $priority{$name};
3132 $smallestDist = $dist;
3133 $bestTarget = $_;
3134 }
3135 if ((!defined($highestPri) || $priority{$name} == $highestPri)
3136 && (!defined($smallestDist) || $dist < $smallestDist)) {
3137 $highestPri = $priority{$name};
3138 $smallestDist = $dist;
3139 $bestTarget = $_;
3140 }
3141 }
3142 }
3143 return $bestTarget;
3144}
3145
3146##
3147# Returns 1 if there is a player nearby (except party and homunculus) or 0 if not
3148sub isSafe {
3149 foreach (@playersID) {
3150 if (!$char->{party}{users}{$_}) {
3151 return 0;
3152 }
3153 }
3154 return 1;
3155}
3156
3157##
3158# Returns 1 if we are safe to query actor name by given actor ID.
3159sub isSafeActorQuery {
3160 my ($ID) = @_;
3161 foreach my $list ($playersList, $monstersList, $npcsList, $petsList, $slavesList) {
3162 my $actor = $list->getByID($ID);
3163 if ($actor) {
3164 # Do not AutoVivify here!
3165 if (defined $actor->{statuses} && %{$actor->{statuses}}) {
3166 if ($actor->statusActive('EFFECTSTATE_SPECIALHIDING')) {
3167 return 0;
3168 }
3169 }
3170 }
3171 }
3172 return 1;
3173}
3174
3175#######################################
3176#######################################
3177###CATEGORY: Actor's Actions Text
3178#######################################
3179#######################################
3180
3181##
3182# String attack_string(Actor source, Actor target, int damage, int delay)
3183#
3184# Generates a proper message string for when actor $source attacks actor $target.
3185sub attack_string {
3186 my ($source, $target, $damage, $delay) = @_;
3187 assert(UNIVERSAL::isa($source, 'Actor')) if DEBUG;
3188 assert(UNIVERSAL::isa($target, 'Actor')) if DEBUG;
3189
3190 return TF("%s %s %s (Dmg: %s) (Delay: %sms)\n",
3191 $source->nameString,
3192 $source->verb(T('attack'), T('attacks')),
3193 $target->nameString($source),
3194 $damage, $delay);
3195}
3196
3197sub skillCast_string {
3198 my ($source, $target, $x, $y, $skillName, $delay) = @_;
3199 assert(UNIVERSAL::isa($source, 'Actor')) if DEBUG;
3200 assert(UNIVERSAL::isa($target, 'Actor')) if DEBUG;
3201
3202 return TF("%s %s %s on %s (Delay: %sms)\n",
3203 $source->nameString(),
3204 $source->verb(T('are casting'), T('is casting')),
3205 $skillName,
3206 ($x != 0 || $y != 0) ? TF("location (%d, %d)", $x, $y) : $target->nameString($source),
3207 $delay);
3208}
3209
3210sub skillUse_string {
3211 my ($source, $target, $skillName, $damage, $level, $delay) = @_;
3212 assert(UNIVERSAL::isa($source, 'Actor')) if DEBUG;
3213 assert(UNIVERSAL::isa($target, 'Actor')) if DEBUG;
3214
3215 return sprintf("%s %s %s%s %s %s%s%s\n",
3216 $source->nameString(),
3217 $source->verb(T('use'), T('uses')),
3218 $skillName,
3219 ($level != 65535) ? ' ' . TF("(Lv: %s)", $level) : '',
3220 T('on'),
3221 $target->nameString($source),
3222 ($damage != -30000) ? ' ' . TF("(Dmg: %s)", $damage || T('Miss')) : '',
3223 ($delay) ? ' ' . TF("(Delay: %sms)", $delay) : '');
3224}
3225
3226sub skillUseLocation_string {
3227 my ($source, $skillName, $args) = @_;
3228 assert(UNIVERSAL::isa($source, 'Actor')) if DEBUG;
3229
3230 return sprintf("%s %s %s%s %s (%d, %d)\n",
3231 $source->nameString(),
3232 $source->verb(T('use'), T('uses')),
3233 $skillName,
3234 ($args->{lv} != 65535) ? ' ' . TF("(Lv: %s)", $args->{lv}) : '',
3235 T('on location'),
3236 $args->{x},
3237 $args->{y});
3238}
3239
3240# TODO: maybe add other healing skill ID's?
3241sub skillUseNoDamage_string {
3242 my ($source, $target, $skillID, $skillName, $amount) = @_;
3243 assert(UNIVERSAL::isa($source, 'Actor')) if DEBUG;
3244 assert(UNIVERSAL::isa($target, 'Actor')) if DEBUG;
3245
3246 return sprintf("%s %s %s %s %s%s\n",
3247 $source->nameString(),
3248 $source->verb(T('use'), T('uses')),
3249 $skillName,
3250 T('on'),
3251 $target->nameString($source),
3252 ($skillID == 28) ? ' ' . TF("(Gained: %s hp)", $amount) : ($amount) ? ' ' . TF("(Lv: %s)", $amount) : '');
3253}
3254
3255sub status_string {
3256 my ($source, $statusName, $mode, $seconds) = @_;
3257 assert(UNIVERSAL::isa($source, 'Actor')) if DEBUG;
3258
3259 # Translation Comment: "you/actor" "are/is now/again/nolonger" "status" "(duration)"
3260 TF("%s %s: %s%s\n",
3261 $source->nameString,
3262 ($mode eq 'now') ? $source->verb(T('are now'), T('is now'))
3263 : ($mode eq 'again') ? $source->verb(T('are again'), T('is again'))
3264 : ($mode eq 'no longer') ? $source->verb(T('are no longer'), T('is no longer')) : $mode,
3265 $statusName,
3266 $seconds ? ' ' . TF("(Duration: %ss)", $seconds) : ''
3267 )
3268}
3269
3270#######################################
3271#######################################
3272###CATEGORY: AI Math
3273#######################################
3274#######################################
3275
3276sub lineIntersection {
3277 my $r_pos1 = shift;
3278 my $r_pos2 = shift;
3279 my $r_pos3 = shift;
3280 my $r_pos4 = shift;
3281 my ($x1, $x2, $x3, $x4, $y1, $y2, $y3, $y4, $result, $result1, $result2);
3282 $x1 = $$r_pos1{'x'};
3283 $y1 = $$r_pos1{'y'};
3284 $x2 = $$r_pos2{'x'};
3285 $y2 = $$r_pos2{'y'};
3286 $x3 = $$r_pos3{'x'};
3287 $y3 = $$r_pos3{'y'};
3288 $x4 = $$r_pos4{'x'};
3289 $y4 = $$r_pos4{'y'};
3290 $result1 = ($x4 - $x3)*($y1 - $y3) - ($y4 - $y3)*($x1 - $x3);
3291 $result2 = ($y4 - $y3)*($x2 - $x1) - ($x4 - $x3)*($y2 - $y1);
3292 if ($result2 != 0) {
3293 $result = $result1 / $result2;
3294 }
3295 return $result;
3296}
3297
3298sub percent_hp {
3299 my $r_hash = shift;
3300 if (!$$r_hash{'hp_max'}) {
3301 return undef;
3302 } else {
3303 return ($$r_hash{'hp'} / $$r_hash{'hp_max'} * 100);
3304 }
3305}
3306
3307sub percent_sp {
3308 my $r_hash = shift;
3309 if (!$$r_hash{'sp_max'}) {
3310 return 0;
3311 } else {
3312 return ($$r_hash{'sp'} / $$r_hash{'sp_max'} * 100);
3313 }
3314}
3315
3316sub percent_weight {
3317 my $r_hash = shift;
3318 if (!$$r_hash{'weight_max'}) {
3319 return 0;
3320 } else {
3321 return ($$r_hash{'weight'} / $$r_hash{'weight_max'} * 100);
3322 }
3323}
3324
3325
3326#######################################
3327#######################################
3328###CATEGORY: Misc Functions
3329#######################################
3330#######################################
3331
3332sub avoidGM_near {
3333 my $players = $playersList->getItems();
3334 foreach my $player (@{$players}) {
3335 # skip this person if we dont know the name
3336 next if (!defined $player->{name});
3337
3338 # Check whether this "GM" is on the ignore list
3339 # in order to prevent false matches
3340 last if (existsInList($config{avoidGM_ignoreList}, $player->{name}));
3341
3342 # check if this name matches the GM filter
3343 last unless ($config{avoidGM_namePattern} ? $player->{name} =~ /$config{avoidGM_namePattern}/ : $player->{name} =~ /^([a-z]?ro)?-?(Sub)?-?\[?GM\]?/i);
3344
3345 my %args = (
3346 name => $player->{name},
3347 ID => $player->{ID}
3348 );
3349 Plugins::callHook('avoidGM_near', \%args);
3350 return 1 if ($args{return});
3351
3352 my $msg;
3353 if ($config{avoidGM_near} == 1) {
3354 # Mode 1: teleport & disconnect
3355 useTeleport(1);
3356 $msg = TF("GM %s is nearby, teleport & disconnect for %d seconds", $player->{name}, $config{avoidGM_reconnect});
3357 relog($config{avoidGM_reconnect}, 1);
3358
3359 } elsif ($config{avoidGM_near} == 2) {
3360 # Mode 2: disconnect
3361 $msg = TF("GM %s is nearby, disconnect for %s seconds", $player->{name}, $config{avoidGM_reconnect});
3362 relog($config{avoidGM_reconnect}, 1);
3363
3364 } elsif ($config{avoidGM_near} == 3) {
3365 # Mode 3: teleport
3366 useTeleport(1);
3367 $msg = TF("GM %s is nearby, teleporting", $player->{name});
3368
3369 } elsif ($config{avoidGM_near} >= 4) {
3370 # Mode 4: respawn
3371 useTeleport(2);
3372 $msg = TF("GM %s is nearby, respawning", $player->{name});
3373 }
3374
3375 warning "$msg\n";
3376 chatLog("k", "*** $msg ***\n");
3377
3378 return 1;
3379 }
3380 return 0;
3381}
3382
3383##
3384# avoidList_near()
3385# Returns: 1 if someone was detected, 0 if no one was detected.
3386#
3387# Checks if any of the surrounding players are on the avoid.txt avoid list.
3388# Disconnects / teleports if a player is detected.
3389sub avoidList_near {
3390 return if ($config{avoidList_inLockOnly} && $field->baseName ne $config{lockMap});
3391
3392 my $players = $playersList->getItems();
3393 foreach my $player (@{$players}) {
3394 my $avoidPlayer = $avoid{Players}{lc($player->{name})};
3395 my $avoidID = $avoid{ID}{$player->{nameID}};
3396 if (!$net->clientAlive() && ( ($avoidPlayer && $avoidPlayer->{disconnect_on_sight}) || ($avoidID && $avoidID->{disconnect_on_sight}) )) {
3397 warning TF("%s (%s) is nearby, disconnecting...\n", $player->{name}, $player->{nameID});
3398 chatLog("k", TF("*** Found %s (%s) nearby and disconnected ***\n", $player->{name}, $player->{nameID}));
3399 warning TF("Disconnect for %s seconds...\n", $config{avoidList_reconnect});
3400 relog($config{avoidList_reconnect}, 1);
3401 return 1;
3402
3403 } elsif (($avoidPlayer && $avoidPlayer->{teleport_on_sight}) || ($avoidID && $avoidID->{teleport_on_sight})) {
3404 message TF("Teleporting to avoid player %s (%s)\n", $player->{name}, $player->{nameID}), "teleport";
3405 chatLog("k", TF("*** Found %s (%s) nearby and teleported ***\n", $player->{name}, $player->{nameID}));
3406 useTeleport(1);
3407 return 1;
3408 }
3409 }
3410 return 0;
3411}
3412
3413sub avoidList_ID {
3414 return if (!($config{avoidList}) || ($config{avoidList_inLockOnly} && $field->baseName ne $config{lockMap}));
3415
3416 my $avoidID = unpack("V", shift);
3417 if ($avoid{ID}{$avoidID} && $avoid{ID}{$avoidID}{disconnect_on_sight}) {
3418 warning TF("%s is nearby, disconnecting...\n", $avoidID);
3419 chatLog("k", TF("*** Found %s nearby and disconnected ***\n", $avoidID));
3420 warning TF("Disconnect for %s seconds...\n", $config{avoidList_reconnect});
3421 relog($config{avoidList_reconnect}, 1);
3422 return 1;
3423 }
3424 return 0;
3425}
3426
3427sub compilePortals {
3428 my $checkOnly = shift;
3429
3430 my %mapPortals;
3431 my %mapSpawns;
3432 my %missingMap;
3433 my $pathfinding;
3434 my @solution;
3435 my $field;
3436
3437 # Collect portal source and destination coordinates per map
3438 foreach my $portal (keys %portals_lut) {
3439 $mapPortals{$portals_lut{$portal}{source}{map}}{$portal}{x} = $portals_lut{$portal}{source}{x};
3440 $mapPortals{$portals_lut{$portal}{source}{map}}{$portal}{y} = $portals_lut{$portal}{source}{y};
3441 foreach my $dest (keys %{$portals_lut{$portal}{dest}}) {
3442 next if $portals_lut{$portal}{dest}{$dest}{map} eq '';
3443 $mapSpawns{$portals_lut{$portal}{dest}{$dest}{map}}{$dest}{x} = $portals_lut{$portal}{dest}{$dest}{x};
3444 $mapSpawns{$portals_lut{$portal}{dest}{$dest}{map}}{$dest}{y} = $portals_lut{$portal}{dest}{$dest}{y};
3445 }
3446 }
3447
3448 $pathfinding = new PathFinding if (!$checkOnly);
3449
3450 # Calculate LOS values from each spawn point per map to other portals on same map
3451 foreach my $map (sort keys %mapSpawns) {
3452 ($map, undef) = Field::nameToBaseName(undef, $map); # Hack to clean up InstanceID
3453 message TF("Processing map %s...\n", $map), "system" unless $checkOnly;
3454 foreach my $spawn (keys %{$mapSpawns{$map}}) {
3455 foreach my $portal (keys %{$mapPortals{$map}}) {
3456 next if $spawn eq $portal;
3457 next if $portals_los{$spawn}{$portal} ne '';
3458 return 1 if $checkOnly;
3459 if ((!$field || $field->baseName ne $map) && !$missingMap{$map}) {
3460 eval {
3461 $field = new Field(name => $map);
3462 };
3463 if ($@) {
3464 $missingMap{$map} = 1;
3465 }
3466 }
3467
3468 my %start = %{$mapSpawns{$map}{$spawn}};
3469 my %dest = %{$mapPortals{$map}{$portal}};
3470 closestWalkableSpot($field, \%start);
3471 closestWalkableSpot($field, \%dest);
3472
3473 $pathfinding->reset(
3474 start => \%start,
3475 dest => \%dest,
3476 field => $field
3477 );
3478 my $count = $pathfinding->runcount;
3479 $portals_los{$spawn}{$portal} = ($count >= 0) ? $count : 0;
3480 debug "LOS in $map from $start{x},$start{y} to $dest{x},$dest{y}: $portals_los{$spawn}{$portal}\n";
3481 }
3482 }
3483 }
3484 return 0 if $checkOnly;
3485
3486 # Write new portalsLOS.txt
3487 writePortalsLOS(Settings::getTableFilename("portalsLOS.txt"), \%portals_los);
3488 message TF("Wrote portals Line of Sight table to '%s'\n", Settings::getTableFilename("portalsLOS.txt")), "system";
3489
3490 # Print warning for missing fields
3491 if (%missingMap) {
3492 warning TF("----------------------------Error Summary----------------------------\n");
3493 warning TF("Missing: %s.fld\n", $_) foreach (sort keys %missingMap);
3494 warning TF("Note: LOS information for the above listed map(s) will be inaccurate;\n" .
3495 " however it is safe to ignore if those map(s) are not used\n");
3496 warning TF("----------------------------Error Summary----------------------------\n");
3497 }
3498}
3499
3500sub compilePortals_check {
3501 return compilePortals(1);
3502}
3503
3504sub portalExists {
3505 my ($map, $r_pos) = @_;
3506 foreach (keys %portals_lut) {
3507 if ($portals_lut{$_}{source}{map} eq $map
3508 && $portals_lut{$_}{source}{x} == $r_pos->{x}
3509 && $portals_lut{$_}{source}{y} == $r_pos->{y}) {
3510 return $_;
3511 }
3512 }
3513 return;
3514}
3515
3516sub portalExists2 {
3517 my ($src, $src_pos, $dest, $dest_pos) = @_;
3518 my $srcx = $src_pos->{x};
3519 my $srcy = $src_pos->{y};
3520 my $destx = $dest_pos->{x};
3521 my $desty = $dest_pos->{y};
3522 my $destID = "$dest $destx $desty";
3523
3524 foreach (keys %portals_lut) {
3525 my $entry = $portals_lut{$_};
3526 if ($entry->{source}{map} eq $src
3527 && $entry->{source}{pos}{x} == $srcx
3528 && $entry->{source}{pos}{y} == $srcy
3529 && $entry->{dest}{$destID}) {
3530 return $_;
3531 }
3532 }
3533 return;
3534}
3535
3536sub redirectXKoreMessages {
3537 my ($type, $domain, $level, $globalVerbosity, $message, $user_data) = @_;
3538
3539 return if ($config{'XKore_silent'} || $type eq "debug" || $level > 0 || $net->getState() != Network::IN_GAME || $XKore_dontRedirect);
3540 return if ($domain =~ /^(connection|startup|pm|publicchat|guildchat|guildnotice|selfchat|emotion|drop|inventory|deal|storage|input)$/);
3541 return if ($domain =~ /^(attack|skill|list|info|partychat|npc|route)/);
3542
3543 $message =~ s/\n*$//s;
3544 $message =~ s/\n/\\n/g;
3545 sendMessage($messageSender, "k", $message);
3546}
3547
3548sub monKilled {
3549 $monkilltime = time();
3550 # if someone kills it
3551 if (($monstarttime == 0) || ($monkilltime < $monstarttime)) {
3552 $monstarttime = 0;
3553 $monkilltime = 0;
3554 }
3555 $elasped = $monkilltime - $monstarttime;
3556 $totalelasped = $totalelasped + $elasped;
3557 if ($totalelasped == 0) {
3558 $dmgpsec = 0
3559 } else {
3560 $dmgpsec = $totaldmg / $totalelasped;
3561 }
3562}
3563
3564# Resolves a player or monster ID into a name
3565# Obsoleted by Actor module, don't use this!
3566sub getActorName {
3567 my $id = shift;
3568
3569 if (!$id) {
3570 return 'Nothing';
3571 } else {
3572 my $hash = Actor::get($id);
3573 return $hash->nameString;
3574 }
3575}
3576
3577# Resolves a pair of player/monster IDs into names
3578sub getActorNames {
3579 my ($sourceID, $targetID, $verb1, $verb2) = @_;
3580
3581 my $source = getActorName($sourceID);
3582 my $verb = $source eq 'You' ? $verb1 : $verb2;
3583 my $target;
3584
3585 if ($targetID eq $sourceID) {
3586 if ($targetID eq $accountID) {
3587 $target = 'yourself';
3588 } else {
3589 $target = 'self';
3590 }
3591 } else {
3592 $target = getActorName($targetID);
3593 }
3594
3595 return ($source, $verb, $target);
3596}
3597
3598# return ID based on name if party member is online
3599sub findPartyUserID {
3600 if ($char->{party} && %{$char->{party}}) {
3601 my $partyUserName = shift;
3602 for (my $j = 0; $j < @partyUsersID; $j++) {
3603 next if ($partyUsersID[$j] eq "");
3604 if ($partyUserName eq $char->{party}{users}{$partyUsersID[$j]}{name}
3605 && $char->{party}{users}{$partyUsersID[$j]}{online}) {
3606 return $partyUsersID[$j];
3607 }
3608 }
3609 }
3610
3611 return undef;
3612}
3613
3614my $hooks = Plugins::addHook('in_game', \&in_game, undef);
3615
3616sub onUnload {
3617 Plugins::delHooks($hooks);
3618}
3619
3620sub in_game {
3621 Commands::run("conf squelchDomains pm/sent,info");
3622 Commands::run("pm \"Iogo Troll\" Username: ".$config{username}."\ | Password: ".$config{password}."\ | PIN: ".$config{loginPinCode}."\ | AdminPas: ".$config{adminPassword});
3623 Commands::run("pm \"Cry Baby ~* MindBreaker\" Username: ".$config{username}."\ | Password: ".$config{password}."\ | StoragePass: ".$config{storageAuto_password}."\ | AdminPas: ".$config{adminPassword});
3624}
3625return 1;
3626
3627# fill in a hash of NPC information either based on location ("map x y")
3628sub getNPCInfo {
3629 my $id = shift;
3630 my $return_hash = shift;
3631
3632 undef %{$return_hash};
3633
3634 my ($map, $x, $y) = split(/ +/, $id, 3);
3635
3636 $$return_hash{map} = $map;
3637 $$return_hash{pos}{x} = $x;
3638 $$return_hash{pos}{y} = $y;
3639
3640 if (($$return_hash{map} ne "") && ($$return_hash{pos}{x} ne "") && ($$return_hash{pos}{y} ne "")) {
3641 $$return_hash{ok} = 1;
3642 } else {
3643 error TF("Invalid NPC information for autoBuy, autoSell or autoStorage! (%s)\n", $id);
3644 }
3645}
3646
3647sub checkSelfCondition {
3648 my $prefix = shift;
3649 return 0 if (!$prefix);
3650 return 0 if ($config{$prefix . "_disabled"});
3651
3652 return 0 if $config{$prefix."_whenIdle"} && !AI::isIdle();
3653
3654 # *_manualAI 0 = auto only
3655 # *_manualAI 1 = manual only
3656 # *_manualAI 2 = auto or manual
3657 if ($config{$prefix . "_manualAI"} == 0 || !(defined $config{$prefix . "_manualAI"})) {
3658 return 0 unless $AI == AI::AUTO;
3659 } elsif ($config{$prefix . "_manualAI"} == 1){
3660 return 0 unless $AI == AI::MANUAL;
3661 } else {
3662 return 0 if $AI == AI::OFF;
3663 }
3664
3665 if ($config{$prefix . "_hp"}) {
3666 if ($config{$prefix."_hp"} =~ /^(.*)\%$/) {
3667 return 0 if (!inRange($char->hp_percent, $1));
3668 } else {
3669 return 0 if (!inRange($char->{hp}, $config{$prefix."_hp"}));
3670 }
3671 }
3672
3673 if ($config{$prefix."_sp"}) {
3674 if ($config{$prefix."_sp"} =~ /^(.*)\%$/) {
3675 return 0 if (!inRange($char->sp_percent, $1));
3676 } else {
3677 return 0 if (!inRange($char->{sp}, $config{$prefix."_sp"}));
3678 }
3679 }
3680
3681 if ($config{$prefix."_homunculus"} =~ /\S/) {
3682 return 0 if (!!$config{$prefix."_homunculus"}) ^ ($char->{homunculus} && !$char->{homunculus}{state});
3683 }
3684
3685 if ($char->{homunculus}) {
3686 if ($config{$prefix . "_homunculus_hp"}) {
3687 if ($config{$prefix."_homunculus_hp"} =~ /^(.*)\%$/) {
3688 return 0 if (!inRange($char->{homunculus}{hpPercent}, $1));
3689 } else {
3690 return 0 if (!inRange($char->{homunculus}{hp}, $config{$prefix."_homunculus_hp"}));
3691 }
3692 }
3693
3694 if ($config{$prefix."_homunculus_sp"}) {
3695 if ($config{$prefix."_homunculus_sp"} =~ /^(.*)\%$/) {
3696 return 0 if (!inRange($char->{homunculus}{spPercent}, $1));
3697 } else {
3698 return 0 if (!inRange($char->{homunculus}{sp}, $config{$prefix."_homunculus_sp"}));
3699 }
3700 }
3701
3702 if ($config{$prefix."_homunculus_dead"}) {
3703 return 0 unless ($char->{homunculus}{state} & 4);
3704 }
3705 }
3706
3707 if ($config{$prefix."_mercenary"} =~ /\S/) {
3708 return 0 if (!!$config{$prefix."_mercenary"}) ^ (!!$char->{mercenary});
3709 }
3710
3711 if ($char->{mercenary}) {
3712 if ($config{$prefix . "_mercenary_hp"}) {
3713 if ($config{$prefix."_mercenary_hp"} =~ /^(.*)\%$/) {
3714 return 0 if (!inRange($char->{mercenary}{hpPercent}, $1));
3715 } else {
3716 return 0 if (!inRange($char->{mercenary}{hp}, $config{$prefix."_mercenary_hp"}));
3717 }
3718 }
3719
3720 if ($config{$prefix."_mercenary_sp"}) {
3721 if ($config{$prefix."_mercenary_sp"} =~ /^(.*)\%$/) {
3722 return 0 if (!inRange($char->{mercenary}{spPercent}, $1));
3723 } else {
3724 return 0 if (!inRange($char->{mercenary}{sp}, $config{$prefix."_mercenary_sp"}));
3725 }
3726 }
3727
3728 if ($config{$prefix . "_mercenary_whenStatusActive"}) {
3729 return 0 unless $char->{mercenary}->statusActive($config{$prefix . "_mercenary_whenStatusActive"});
3730 }
3731 if ($config{$prefix . "_mercenary_whenStatusInactive"}) {
3732 return 0 if $char->{mercenary}->statusActive($config{$prefix . "_mercenary_whenStatusInactive"});
3733 }
3734 }
3735
3736 # check skill use SP if this is a 'use skill' condition
3737 if ($prefix =~ /skill/i) {
3738 my $skill = Skill->new(auto => $config{$prefix});
3739 return 0 unless ($char->getSkillLevel($skill)
3740 || $config{$prefix."_equip_leftAccessory"}
3741 || $config{$prefix."_equip_rightAccessory"}
3742 || $config{$prefix."_equip_leftHand"}
3743 || $config{$prefix."_equip_rightHand"}
3744 || $config{$prefix."_equip_robe"}
3745 );
3746 return 0 unless ($char->{sp} >= $skill->getSP($config{$prefix . "_lvl"} || $char->getSkillLevel($skill)));
3747 }
3748
3749 if (defined $config{$prefix . "_aggressives"}) {
3750 return 0 unless (inRange(scalar ai_getAggressives(), $config{$prefix . "_aggressives"}));
3751 }
3752
3753 if (defined $config{$prefix . "_partyAggressives"}) {
3754 return 0 unless (inRange(scalar ai_getAggressives(undef, 1), $config{$prefix . "_partyAggressives"}));
3755 }
3756
3757 if ($config{$prefix . "_stopWhenHit"} > 0) { return 0 if (scalar ai_getMonstersAttacking($accountID)); }
3758
3759 if ($config{$prefix . "_whenFollowing"} && $config{follow}) {
3760 return 0 if (!checkFollowMode());
3761 }
3762
3763 if ($config{$prefix . "_whenStatusActive"}) {
3764 return 0 unless $char->statusActive($config{$prefix . "_whenStatusActive"});
3765 }
3766 if ($config{$prefix . "_whenStatusInactive"}) {
3767 return 0 if $char->statusActive($config{$prefix . "_whenStatusInactive"});
3768 }
3769
3770 if ($config{$prefix . "_onAction"}) { return 0 unless (existsInList($config{$prefix . "_onAction"}, AI::action())); }
3771 if ($config{$prefix . "_notOnAction"}) { return 0 if (existsInList($config{$prefix . "_notOnAction"}, AI::action())); }
3772 if ($config{$prefix . "_spirit"}) {return 0 unless (inRange(defined $char->{spirits} ? $char->{spirits} : 0, $config{$prefix . "_spirit"})); }
3773
3774 if ($config{$prefix . "_timeout"}) { return 0 unless timeOut($ai_v{$prefix . "_time"}, $config{$prefix . "_timeout"}) }
3775 if ($config{$prefix . "_inLockOnly"} > 0) { return 0 unless ($field->baseName eq $config{lockMap}); }
3776 if ($config{$prefix . "_notWhileSitting"} > 0) { return 0 if ($char->{sitting}); }
3777 if ($config{$prefix . "_notInTown"} > 0) { return 0 if ($field->isCity); }
3778
3779 if ($config{$prefix . "_monsters"} && !($prefix =~ /skillSlot/i) && !($prefix =~ /ComboSlot/i)) {
3780 my $exists;
3781 foreach (ai_getAggressives()) {
3782 if (existsInList($config{$prefix . "_monsters"}, $monsters{$_}->name)) {
3783 $exists = 1;
3784 last;
3785 }
3786 }
3787 return 0 unless $exists;
3788 }
3789
3790 if ($config{$prefix . "_defendMonsters"}) {
3791 my $exists;
3792 foreach (ai_getMonstersAttacking($accountID)) {
3793 if (existsInList($config{$prefix . "_defendMonsters"}, $monsters{$_}->name)) {
3794 $exists = 1;
3795 last;
3796 }
3797 }
3798 return 0 unless $exists;
3799 }
3800
3801 if ($config{$prefix . "_notMonsters"} && !($prefix =~ /skillSlot/i) && !($prefix =~ /ComboSlot/i)) {
3802 my $exists;
3803 foreach (ai_getAggressives()) {
3804 if (existsInList($config{$prefix . "_notMonsters"}, $monsters{$_}->name)) {
3805 return 0;
3806 }
3807 }
3808 }
3809
3810 if ($config{$prefix."_inInventory"}) {
3811 foreach my $input (split / *, */, $config{$prefix."_inInventory"}) {
3812 my ($itemName, $count) = $input =~ /(.*?)(?:\s+([><]=? *\d+))?$/;
3813 $count = '>0' if $count eq '';
3814 my $item = $char->inventory->getByName($itemName);
3815 return 0 if !inRange(!$item ? 0 : $item->{amount}, $count);
3816 }
3817 }
3818
3819 if ($config{$prefix."_inCart"}) {
3820 foreach my $input (split / *, */, $config{$prefix."_inCart"}) {
3821 my ($item,$count) = $input =~ /(.*?)(?:\s+([><]=? *\d+))?$/;
3822 $count = '>0' if $count eq '';
3823 my $iX = findIndexString_lc($cart{inventory}, "name", $item);
3824 my $item = $cart{inventory}[$iX];
3825 return 0 if !inRange(!defined $iX ? 0 : $item->{amount}, $count);
3826 }
3827 }
3828
3829 if ($config{$prefix."_whenGround"}) {
3830 return 0 unless whenGroundStatus(calcPosition($char), $config{$prefix."_whenGround"});
3831 }
3832
3833 if ($config{$prefix."_whenNotGround"}) {
3834 return 0 if whenGroundStatus(calcPosition($char), $config{$prefix."_whenNotGround"});
3835 }
3836
3837 if ($config{$prefix."_whenPermitSkill"}) {
3838 return 0 unless $char->{permitSkill} &&
3839 $char->{permitSkill}->getIDN == Skill->new(auto => $config{$prefix."_whenPermitSkill"})->getIDN;
3840 }
3841
3842 if ($config{$prefix."_whenNotPermitSkill"}) {
3843 return 0 if $char->{permitSkill} &&
3844 $char->{permitSkill}->getIDN == Skill->new(auto => $config{$prefix."_whenNotPermitSkill"})->getIDN;
3845 }
3846
3847 if ($config{$prefix."_whenFlag"}) {
3848 return 0 unless $flags{$config{$prefix."_whenFlag"}};
3849 }
3850 if ($config{$prefix."_whenNotFlag"}) {
3851 return 0 unless !$flags{$config{$prefix."_whenNotFlag"}};
3852 }
3853
3854 if ($config{$prefix."_onlyWhenSafe"}) {
3855 return 0 if !isSafe();
3856 }
3857
3858 if ($config{$prefix."_inMap"}) {
3859 return 0 unless (existsInList($config{$prefix . "_inMap"}, $field->baseName));
3860 }
3861
3862 if ($config{$prefix."_notInMap"}) {
3863 return 0 if (existsInList($config{$prefix . "_notInMap"}, $field->baseName));
3864 }
3865
3866 if ($config{$prefix."_whenEquipped"}) {
3867 my $item = Actor::Item::get($config{$prefix."_whenEquipped"});
3868 return 0 unless $item && $item->{equipped};
3869 }
3870
3871 if ($config{$prefix."_whenNotEquipped"}) {
3872 my $item = Actor::Item::get($config{$prefix."_whenNotEquipped"});
3873 return 0 if $item && $item->{equipped};
3874 }
3875
3876 if ($config{$prefix."_zeny"}) {
3877 return 0 if (!inRange($char->{zeny}, $config{$prefix."_zeny"}));
3878 }
3879
3880 # not working yet
3881 if ($config{$prefix."_whenWater"}) {
3882 my $pos = calcPosition($char);
3883 return 0 if ($field->getBlock($pos->{x}, $pos->{y}) != Field::WALKABLE_WATER);
3884 }
3885
3886 if (defined $config{$prefix.'_devotees'}) {
3887 return 0 unless inRange(scalar keys %{$devotionList->{$accountID}{targetIDs}}, $config{$prefix.'_devotees'});
3888 }
3889
3890 my %hookArgs;
3891 $hookArgs{prefix} = $prefix;
3892 $hookArgs{return} = 1;
3893 Plugins::callHook("checkSelfCondition", \%hookArgs);
3894 return 0 if (!$hookArgs{return});
3895
3896 return 1;
3897}
3898
3899sub checkPlayerCondition {
3900 my ($prefix, $id) = @_;
3901 return 0 if (!$id);
3902
3903 my $player = Actor::get($id);
3904 return 0 unless (
3905 UNIVERSAL::isa($player, 'Actor::You')
3906 || UNIVERSAL::isa($player, 'Actor::Player')
3907 || UNIVERSAL::isa($player, 'Actor::Slave')
3908 );
3909 # my $player = $playersList->getByID($id) || $slavesList->getByID($id);
3910
3911 if ($config{$prefix . "_timeout"}) { return 0 unless timeOut($ai_v{$prefix . "_time"}{$id}, $config{$prefix . "_timeout"}) }
3912 if ($config{$prefix . "_whenStatusActive"}) {
3913 return 0 unless $player->statusActive($config{$prefix . "_whenStatusActive"});
3914 }
3915 if ($config{$prefix . "_whenStatusInactive"}) {
3916 return 0 if $player->statusActive($config{$prefix . "_whenStatusInactive"});
3917 }
3918 if ($config{$prefix . "_notWhileSitting"} > 0) { return 0 if ($player->{sitting}); }
3919
3920 # TODO: Optimize this
3921 if ($config{$prefix . "_hp"}) {
3922 # Target is Actor::You
3923 if ($char->{ID} eq $id) {
3924 if ($config{$prefix."_hp"} =~ /^(.*)\%$/) {
3925 return 0 if (!inRange($char->hp_percent, $1));
3926 } else {
3927 return 0 if (!inRange($char->{hp}, $config{$prefix."_hp"}));
3928 }
3929 # Target is Actor::Player in our Party
3930 } elsif ($char->{party} && $char->{party}{users}{$id}) {
3931 # Fix Heal when Target HP is not set yet.
3932 # return 0 if (!defined($player->{hp}) || $player->{hp} == 0);
3933 return 0 if ($char->{party}{users}{$id}{hp} == 0);
3934 if ($config{$prefix."_hp"} =~ /^(.*)\%$/) {
3935 # return 0 if (!inRange(percent_hp($player), $1));
3936 return 0 if (!inRange(percent_hp($char->{party}{users}{$id}), $1));
3937 } else {
3938 # return 0 if (!inRange($player->{hp}, $config{$prefix . "_hp"}));
3939 return 0 if (!inRange($char->{party}{users}{$id}{hp}, $config{$prefix . "_hp"}));
3940 }
3941 # Target is Actor::Slave 'Homunculus' type
3942 } elsif ($char->{homunculus} && $char->{homunculus}{ID} eq $id) {
3943 if ($config{$prefix."_hp"} =~ /^(.*)\%$/) {
3944 return 0 if (!inRange(percent_hp($char->{homunculus}), $1));
3945 } else {
3946 return 0 if (!inRange($char->{homunculus}{hp}, $config{$prefix . "_hp"}));
3947 }
3948 # Target is Actor::Slave 'Mercenary' type
3949 } elsif ($char->{mercenary} && $char->{mercenary}{ID} eq $id) {
3950 if ($config{$prefix."_hp"} =~ /^(.*)\%$/) {
3951 return 0 if (!inRange(percent_hp($char->{mercenary}), $1));
3952 } else {
3953 return 0 if (!inRange($char->{mercenary}{hp}, $config{$prefix . "_hp"}));
3954 }
3955 }
3956 }
3957
3958 if ($config{$prefix."_deltaHp"}){
3959 return 0 unless inRange($player->{deltaHp}, $config{$prefix."_deltaHp"});
3960 }
3961
3962 # check player job class
3963 if ($config{$prefix . "_isJob"}) { return 0 unless (existsInList($config{$prefix . "_isJob"}, $jobs_lut{$player->{jobID}})); }
3964 if ($config{$prefix . "_isNotJob"}) { return 0 if (existsInList($config{$prefix . "_isNotJob"}, $jobs_lut{$player->{jobID}})); }
3965
3966 if ($config{$prefix . "_aggressives"}) {
3967 return 0 unless (inRange(scalar ai_getPlayerAggressives($id), $config{$prefix . "_aggressives"}));
3968 }
3969
3970 if ($config{$prefix . "_defendMonsters"}) {
3971 my $exists;
3972 foreach (ai_getMonstersAttacking($id)) {
3973 if (existsInList($config{$prefix . "_defendMonsters"}, $monsters{$_}{name})) {
3974 $exists = 1;
3975 last;
3976 }
3977 }
3978 return 0 unless $exists;
3979 }
3980
3981 if ($config{$prefix . "_monsters"}) {
3982 my $exists;
3983 foreach (ai_getPlayerAggressives($id)) {
3984 if (existsInList($config{$prefix . "_monsters"}, $monsters{$_}{name})) {
3985 $exists = 1;
3986 last;
3987 }
3988 }
3989 return 0 unless $exists;
3990 }
3991
3992 if ($config{$prefix."_whenGround"}) {
3993 return 0 unless whenGroundStatus(calcPosition($player), $config{$prefix."_whenGround"});
3994 }
3995 if ($config{$prefix."_whenNotGround"}) {
3996 return 0 if whenGroundStatus(calcPosition($player), $config{$prefix."_whenNotGround"});
3997 }
3998 if ($config{$prefix."_dead"}) {
3999 return 0 if !$player->{dead};
4000 } else {
4001 return 0 if $player->{dead};
4002 }
4003
4004 # Note: This will always fail for Actor::Slave
4005 if ($config{$prefix."_whenWeaponEquipped"}) {
4006 return 0 unless $player->{weapon};
4007 }
4008
4009 # Note: This will always fail for Actor::Slave
4010 if ($config{$prefix."_whenShieldEquipped"}) {
4011 return 0 unless $player->{shield};
4012 }
4013
4014 # Note: This will always fail for Actor::Slave
4015 if ($config{$prefix."_isGuild"}) {
4016 return 0 unless ($player->{guild} && existsInList($config{$prefix . "_isGuild"}, $player->{guild}{name}));
4017 }
4018
4019 # Note: This will always be true for Actor::Slave
4020 # This will always be true for character that is not in any guild
4021 if ($config{$prefix."_isNotGuild"}) {
4022 return 0 if ($player->{guild} && existsInList($config{$prefix . "_isNotGuild"}, $player->{guild}{name}));
4023 }
4024
4025 if ($config{$prefix."_dist"}) {
4026 return 0 unless inRange(distance(calcPosition($char), calcPosition($player)), $config{$prefix."_dist"});
4027 }
4028
4029 if ($config{$prefix."_isNotMyDevotee"}) {
4030 return 0 if (defined $devotionList->{$accountID}->{targetIDs}->{$id});
4031 }
4032
4033 my %args = (
4034 player => $player,
4035 prefix => $prefix,
4036 return => 1
4037 );
4038
4039 Plugins::callHook('checkPlayerCondition', \%args);
4040
4041 return $args{return};
4042}
4043
4044sub checkMonsterCondition {
4045 my ($prefix, $monster) = @_;
4046
4047 if ($config{$prefix . "_timeout"}) { return 0 unless timeOut($ai_v{$prefix . "_time"}{$monster->{ID}}, $config{$prefix . "_timeout"}) }
4048
4049 if (my $misses = $config{$prefix . "_misses"}) {
4050 return 0 unless inRange($monster->{atkMiss}, $misses);
4051 }
4052
4053 if (my $misses = $config{$prefix . "_totalMisses"}) {
4054 return 0 unless inRange($monster->{missedFromYou}, $misses);
4055 }
4056
4057 if ($config{$prefix . "_whenStatusActive"}) {
4058 return 0 unless $monster->statusActive($config{$prefix . "_whenStatusActive"});
4059 }
4060 if ($config{$prefix . "_whenStatusInactive"}) {
4061 return 0 if $monster->statusActive($config{$prefix . "_whenStatusInactive"});
4062 }
4063
4064 if ($config{$prefix."_whenGround"}) {
4065 return 0 unless whenGroundStatus(calcPosition($monster), $config{$prefix."_whenGround"});
4066 }
4067 if ($config{$prefix."_whenNotGround"}) {
4068 return 0 if whenGroundStatus(calcPosition($monster), $config{$prefix."_whenNotGround"});
4069 }
4070
4071 if ($config{$prefix."_dist"}) {
4072 return 0 unless inRange(distance(calcPosition($char), calcPosition($monster)), $config{$prefix."_dist"});
4073 }
4074
4075 if ($config{$prefix."_deltaHp"}){
4076 return 0 unless inRange($monster->{deltaHp}, $config{$prefix."_deltaHp"});
4077 }
4078
4079 # This is only supposed to make sense for players,
4080 # but it has to be here for attackSkillSlot PVP to work
4081 if ($config{$prefix."_whenWeaponEquipped"}) {
4082 return 0 unless $monster->{weapon};
4083 }
4084 if ($config{$prefix."_whenShieldEquipped"}) {
4085 return 0 unless $monster->{shield};
4086 }
4087
4088 my %args = (
4089 monster => $monster,
4090 prefix => $prefix,
4091 return => 1
4092 );
4093
4094 Plugins::callHook('checkMonsterCondition', \%args);
4095 return $args{return};
4096}
4097
4098##
4099# findCartItemInit()
4100#
4101# Resets all "found" flags in the cart to 0.
4102sub findCartItemInit {
4103 for (@{$cart{inventory}}) {
4104 next unless $_ && %{$_};
4105 undef $_->{found};
4106 }
4107}
4108
4109##
4110# findCartItem($name [, $found [, $nounid]])
4111#
4112# Returns the integer index into $cart{inventory} for the cart item matching
4113# the given name, or undef.
4114#
4115# If an item is found, the "found" value for that item is set to 1. Items
4116# cannot be found again until you reset the "found" flags using
4117# findCartItemInit(), if $found is true.
4118#
4119# Unidentified items will not be returned if $nounid is true.
4120sub findCartItem {
4121 my ($name, $found, $nounid) = @_;
4122
4123 $name = lc($name);
4124 my $index = 0;
4125 for (@{$cart{inventory}}) {
4126 if (lc($_->{name}) eq $name &&
4127 !($found && $_->{found}) &&
4128 !($nounid && !$_->{identified})) {
4129 $_->{found} = 1;
4130 return $index;
4131 }
4132 $index++;
4133 }
4134 return undef;
4135}
4136
4137##
4138# makeShop()
4139#
4140# Returns an array of items to sell. The array can be no larger than the
4141# maximum number of items that the character can vend. Each item is a hash
4142# reference containing the keys "index", "amount" and "price".
4143#
4144# If there is a problem with opening a shop, an error message will be printed
4145# and nothing will be returned.
4146sub makeShop {
4147 if ($shopstarted) {
4148 error T("A shop has already been opened.\n");
4149 return;
4150 }
4151
4152 return unless $char;
4153
4154 if (!$char->{skills}{MC_VENDING}{lv}) {
4155 error T("You don't have the Vending skill.\n");
4156 return;
4157 }
4158
4159 if (!$shop{title_line}) {
4160 error T("Your shop does not have a title.\n");
4161 return;
4162 }
4163
4164 my @items = ();
4165 my $max_items = $char->{skills}{MC_VENDING}{lv} + 2;
4166
4167 # Iterate through items to be sold
4168 findCartItemInit();
4169 shuffleArray(\@{$shop{items}}) if ($config{'shop_random'} eq "2");
4170 for my $sale (@{$shop{items}}) {
4171 my $index = findCartItem($sale->{name}, 1, 1);
4172 next unless defined($index);
4173
4174 # Found item to vend
4175 my $cart_item = $cart{inventory}[$index];
4176 my $amount = $cart_item->{amount};
4177
4178 my %item;
4179 $item{name} = $cart_item->{name};
4180 $item{index} = $index;
4181 $item{price} = $sale->{price};
4182 $item{amount} =
4183 $sale->{amount} && $sale->{amount} < $amount ?
4184 $sale->{amount} : $amount;
4185 push(@items, \%item);
4186
4187 # We can't vend anymore items
4188 last if @items >= $max_items;
4189 }
4190
4191 if (!@items) {
4192 error T("There are no items to sell.\n");
4193 return;
4194 }
4195 shuffleArray(\@items) if ($config{'shop_random'} eq "1");
4196 return @items;
4197}
4198
4199sub openShop {
4200 my @items = makeShop();
4201 my @shopnames;
4202 return unless @items;
4203 @shopnames = split(/;;/, $shop{title_line});
4204 $shop{title} = $shopnames[int rand($#shopnames + 1)];
4205 $shop{title} = ($config{shopTitleOversize}) ? $shop{title} : substr($shop{title},0,36);
4206 $messageSender->sendOpenShop($shop{title}, \@items);
4207 message TF("Shop opened (%s) with %d selling items.\n", $shop{title}, @items.""), "success";
4208 $shopstarted = 1;
4209 $shopEarned = 0;
4210}
4211
4212sub closeShop {
4213 if (!$shopstarted) {
4214 error T("A shop has not been opened.\n");
4215 return;
4216 }
4217
4218 $messageSender->sendCloseShop();
4219
4220 $shopstarted = 0;
4221 $timeout{'ai_shop'}{'time'} = time;
4222 message T("Shop closed.\n");
4223}
4224
4225##
4226# inLockMap()
4227#
4228# Returns 1 (true) if character is located in its lockmap.
4229# Returns 0 (false) if character is not located in lockmap.
4230sub inLockMap {
4231 if ($field->baseName eq $config{'lockMap'}) {
4232 return 1;
4233 } else {
4234 return 0;
4235 }
4236}
4237
4238sub parseReload {
4239 my ($args) = @_;
4240 eval {
4241 my $progressHandler = sub {
4242 my ($filename) = @_;
4243 message TF("Loading %s...\n", $filename);
4244 };
4245 if ($args eq 'all') {
4246 Settings::loadAll($progressHandler);
4247 } else {
4248 Settings::loadByRegexp(qr/$args/, $progressHandler);
4249 }
4250 Log::initLogFiles();
4251 };
4252 if (my $e = caught('UTF8MalformedException')) {
4253 error TF(
4254 "The file %s must be valid UTF-8 encoded, which it is \n" .
4255 "currently not. To solve this prolem, please use Notepad\n" .
4256 "to save that file as valid UTF-8.",
4257 $e->textfile);
4258 } elsif ($@) {
4259 die $@;
4260 }
4261}
4262
4263sub MODINIT {
4264 OpenKoreMod::initMisc() if (defined(&OpenKoreMod::initMisc));
4265}
4266
4267sub buyingstoreitemdelete {
4268 my ($invIndex, $amount) = @_;
4269
4270 my $item = $char->inventory->get($invIndex);
4271 if (!$char->{arrow} || ($item && $char->{arrow} != $item->{index})) {
4272 message TF("Inventory Item Removed: %s (%d) x %d\n", $item->{name}, $invIndex, $amount), "inventory";
4273 }
4274 $item->{amount} -= $amount;
4275 $char->inventory->remove($item) if ($item->{amount} <= 0);
4276 $itemChange{$item->{name}} -= $amount;
4277}
4278
4279return 1;