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