Global Perl Utility Functions

[Shendare]

I still have a lot of work to do on my global Perl utility functions, but it has been requested that I post what I currently have for others to make use of, so here goes.

Be sure to do extensive testing of your quests, especially when using these functions, since they are a work in progress.

I'll describe the functions and show how they're used first, then supply the actual code at the end for copying.

(1) Handling items being given to an NPC

Functions:

• givenItems(...) and takeItems(...) - Returns 1 if the required items have been given to the NPC, otherwise 0
• givenCoin(...) and takeCoin(...) - Returns 1 if the required coin has been given to the NPC (any denominations), otherwise 0
• givenItemsCoin(...) and takeItemsCoin(...) - Returns 1 if the required items and coin have been given to the NPC, otherwise 0
• givenPlatinum(...) and takePlatinum(...)
• givenGold(...) and takeGold(...)
• givenSilver(...) and takeSilver(...)
• givenCopper(...) and takeCopper(...)
• returnUnusedItems() - To be called at the end of EVENT_ITEM, returning unneeded items and coin to the player

The difference between the givenXYZ() and takeXYZ() functions is that the "given" functions leave the items in the %itemcount hash and $currency variables to be returned to the player with returnUnusedItems(), while the "take" functions remove the items, consuming them for the quest.

Examples of how to use them:

sub EVENT_ITEM
{
  if (plugin::takeItems(13073 => 4)) # 4 Bone Chips
  {
    quest::say("Your dedication to the war against the evil undead will not go unnoticed, $name.");
  }
  
  if (plugin::givenItems(13007 => 1)) # 1 Rations
  {
    quest::say('Bleah, rations? Can\'t stand them. Can you bring me something tastier?');
  }
  
  if (plugin::takeItemsCoin(0, 0, 2, 0, 1006 => 1, 1018 => 1)) # 2gp, 1 Cloth Cape, 1 Small Cloth Cape
  {
    quest::say('It\'s worth 2 gold and all this material to tailor your cloth cape to fit you? You\'re so vain!');
    
    quest::summonitem(1030); # Large Cloth Cape
  }
  
  if (plugin::takePlatinum(1))
  {
    quest::say('You know how to get my attention! Okay, here\'s the secret info...');
  }
  
  plugin::returnUnusedItems();
}

(2) NPC Utility Functions

I so far have three utility functions I use for general NPC processing, with more likely to come.

Functions:

• fixNPCName() - Convert's an NPC's name from 'a_skeleton005' to 'a skeleton'
• humanoid() - Returns 1 if an NPC's race is humanoid, otherwise 0
• assocName() - Returns an associative name that an NPC might use for a player, based on their faction or status. Instead of all NPCs in the game referring to the player by their name (how can every NPC in the game know every player's name anyway?), most might say "friend" or "stranger" or "Dark Elf", depending on how much they like them.

Examples of how to use them:

sub EVENT_SAY
{
  $mname = plugin::fixNPCName();
    
  if (plugin::humanoid())
  {
    if ($text=~/hail/i)
    {
      $name = plugin::assocName();
  
      quest::say("Hail, $name! I'm $mname. Welcome to the jungle. We've got fun and games!");
    }
  }
  else
  {
    quest::echo("$mname grunts and growls at you.");
  }
}

(3) Zone Utility Functions

I've just barely started these functions, but it's easy to flesh them out however you'd like.

Functions:

• cityName() - Returns the name of the local city based on zone (and sometimes coords)
• quickGreeting() - Generates a random little greeting appropriate to the locale

Examples of how to use them:

sub EVENT_SAY
{
  $city = plugin::cityName();
  $greet = plugin::quickGreeting();
  
  quest::say("$greet, $name! I hope you enjoy your stay in $city!");
}

(4) Accessing $variables from inside a plugin::sub

If you've done plugin coding of your own, you've no doubt discovered that subs in a plugin Perl file do not have access to the regular $variables or %itemcount hash from the EVENT_SAY, EVENT_ITEM, etc. subs.

I managed to get around this problem, implementing the following functions for reading and writing to the available variables from any scope:

Functions:

• val(...) - Returns the value of the variable requested
• setval(...) - Sets the value of the variable specified
• var(...) - Returns a reference(*) to the variable requested

(*) Note on references: These give you read/write access to the contents of an exported variable. However, you must use a double dollar sign on variables returned this way (e.g., $$platinum).

This can get a little tricky. References can be a little hard to understand. If you want to be safe, I recommend you just use val() and setval() to get and set variable values.

One notable exception will be %itemcount, which -must- be used as a reference if you want to be able to make changes to it, such as with takeItems() and returnUnusedItems(). See the example below for the use of a $itemcount reference instead of the %itemcount hash.

Examples of how to use them:

In an NPC .pl file...

sub EVENT_ITEM
{
  plugin::defaultItem();
}

In a plugins .pl file...

sub defaultItem
{
  my $itemcount = plugin::var('%itemcount');
  my ($platinum, $gold, $silver, $copper) = (plugin::val('$platinum'), plugin::val('$gold'), plugin::val('$silver'), plugin::val('$copper'));
  my $item1 = plugin::var('$item1');
  my $itemid1 = $$item1;
  
  my $boneChips = $itemcount->{13073};
  $boneChips = 0 if (!defined($boneChips));

  quest::say("You gave me $boneChips Bone Chips.");
  quest::say("You gave me $platinum pp, $gold gp, $silver sp, $copper cp.");
  quest::say("The item in the first slot you gave me had an id of: $itemid1");
  
  plugin::setval('$copper', 50);
  
  $copper = plugin::val('$copper');
  
  quest::say("After setting \$copper, I now show that you gave me $copper cp.");
}

(5) Actual Code

Okay, here's the code that actually does the work seen in the above examples.

File: plugins\globals.pl

sub nullzero
{
  my $value = shift;
  
  return (defined($value)) ? $value : 0;
}

sub nulltrim
{
  my $value = shift;
  
  if (!defined($value))
  {
    return '';
  }
  else
  {
    $value =~ s/^\s+|\s+$//g;
    
    return $value;
  }
}

sub random
{
  return $_[int(rand(0+@_))];
}

# var - Access a quest-related game variable from within any context
# Parameter: varName
sub var
{
  my $varName = shift;
  
  # Strip leading $, @, or % symbol from variable name
  $varName =~ s/^(\$|@|%)//g;

  if ($varName eq 'mob')
  {
    # Shortcut: Requesting $mob steps into EntityList to get $mob reference for the current NPC.
    
    my $entity_list = plugin::val('entity_list');
  
    return $entity_list->GetMobID(plugin::val('mobid'));
  }
  else
  {
    my(@context, $level, $fullname);
    
    # Step back through the call stack until we get access to the main (non-plugin) variables
    for ($level = 1; $level < 10; $level++)
    {
      @context = caller($level);
      last if (($fullname = substr($context[3], 0, index($context[3], ':') + 2)) ne 'plugin::');
    }
    
    # Sanity check. If something goes horribly wrong and we can't step out of the plugin:: namespace, just return an empty string.
    return '' if ($level >= 10);
    
    $fullname .= $varName;
    
    if ($varName eq 'itemcount')
    {
      # Hash reference
      return \%$fullname;
    }
    elsif (0) #($varName eq 'ArrayVariable')
    {
      # Array reference
      return \@$fullname;
    }
    else
    {
      # Scalar reference
      return \$$fullname;
    }
  }
}

# val - Shortcut that returns the read-only -value- of a quest-related game variable instead of a reference to it
# Parameter: varName
sub val
{
  return ${plugin::var($_[0])};
}

# setVal - Shortcut that sets a scalar quest-related game variable from within any context... works well with val()
# Parameters: varName, newValue
sub setval
{
  ${plugin::var($_[0])} = $_[1] if (@_ > 1);
}

# Returns 1 if the NPC has been given a particular item or set of items. Otherwise, returns 0.
# Parameters: Hash consisting of ItemID => RequiredCount pairs
# NOTE: \%itemcount parameter from older "check_handin" function is NOT necessary and should not be passed!
sub givenItems
{
  my $itemcount = plugin::var('itemcount');
  my %required = @_;
  
  foreach my $req (keys %required)
  {
    if ((!defined($itemcount->{$req})) || ($itemcount->{$req} < $required{$req}))
    {
      return 0;
    }
  }

  return 1;
}

# Like givenItems(), only removes the items from the %itemcount collection for an appropriate returnUnusedItems() call later
# This works just like the old check_handin() function, only again, don't pass \%itemcount.
sub takeItems
{
  my $itemcount = plugin::var('itemcount');
  my %required = @_;
  
  foreach my $req (keys %required)
  {
    if ((!defined($itemcount->{$req})) || ($itemcount->{$req} < $required{$req}))
    {
      return 0;
    }
  }

  foreach my $req (keys %required)
  {
    if ($required{$req} < $itemcount->{$req})
    {
      $itemcount->{$req} -= $required{$req};
    }
    else
    {
      delete $itemcount->{$req};
    }
  }

  return 1;
}

# Checks to see whether the player gave the NPC a requested amount of currency, regardless of actual denominations given.
sub givenCoin
{
  my($c1, $s1, $g1, $p1) = @_;
  my($c2, $s2, $g2, $p2) = (plugin::val('$copper'), plugin::val('$silver'), plugin::val('$gold'), plugin::val('$platinum'));
  
  $c1 = 0 if (!defined($c1));
  $s1 = 0 if (!defined($s1));
  $g1 = 0 if (!defined($g1));
  $p1 = 0 if (!defined($p1));
  
  my $coin1 = $c1 + (10 * $s1) + (100 * $g1) + (1000 * $p1);
  my $coin2 = $c2 + (10 * $s2) + (100 * $g2) + (1000 * $p2);

  return ($coin1 <= $coin2);
}

# Like givenCoin(), only takes the required coins if given enough by the player, also leaving change to be returned with returnUnusedItems().
sub takeCoin
{
  my($c1, $s1, $g1, $p1) = @_;
  my($c2, $s2, $g2, $p2) = (plugin::val('$copper'), plugin::val('$silver'), plugin::val('$gold'), plugin::val('$platinum'));
  
  $c1 = 0 if (!defined($c1));
  $s1 = 0 if (!defined($s1));
  $g1 = 0 if (!defined($g1));
  $p1 = 0 if (!defined($p1));
  
  my $coin1 = $c1 + (10 * $s1) + (100 * $g1) + (1000 * $p1);
  my $coin2 = $c2 + (10 * $s2) + (100 * $g2) + (1000 * $p2);

  if ($coin1 <= $coin2)
  {
    $coin2 -= $coin1;
  
    $c2 = ($coin2 % 10);
    $s2 = (int($coin2 / 10) % 10);
    $g2 = (int($coin2 / 100) % 10);
    $p2 = int($coin2 / 1000);

    plugin::setval('$copper'  , $c2);
    plugin::setval('$silver'  , $s2);
    plugin::setval('$gold'    , $g2);
    plugin::setval('$platinum', $p2);
    
    return 1; # 1 = Successfully took coins
  }
  
  return 0; # 0 = Insufficient funds
}

# Checks for both coin and items in one call.
# Returns 1 if enough items and coin were given to satisfy the provided requirements, otherwise 0.
sub givenItemsCoin
{
  if (@_ < 6)
  {
    return 0;
  }

  my ($c, $s, $g, $p) = (shift, shift, shift, shift);
  
  if (plugin::givenCoin($c, $s, $g, $p))
  {
    return plugin::givenItems(@_);
  }

  return 0;
}

# Like givenItemsCoin, only removes the items if successful, allowing for approprate returnUnusedItems() call later
sub takeItemsCoin
{
  if (@_ < 6)
  {
    return 0;
  }

  my ($c, $s, $g, $p) = (shift, shift, shift, shift);
  
  if (plugin::givenCoin($c, $s, $g, $p))
  {
    if (plugin::takeItems(@_))
    {
      plugin::takeCoin($c, $s, $g, $p);
      
      return 1;
    }
  }

  return 0;
}

# Checks to see whether the player gave the NPC a requested number of platinum
sub givenPlatinum
{
  my $p = shift;
  
  return plugin::givenCoin(0, 0, 0, defined($p) ? $p : 0);
}

# Takes provided coins given by the player
sub takePlatinum
{
  my $p = shift;
  
  return plugin::takeCoin(0, 0, 0, defined($p) ? $p : 0);
}

# Checks to see whether the player gave the NPC a requested number of gold
sub givenGold
{
  my $g = shift;
  
  return plugin::givenCoin(0, 0, defined($g) ? $g : 0, 0);
}

# Takes provided coins given by the player
sub takeGold
{
  my $g = shift;
  
  return plugin::takeCoin(0, 0, defined($g) ? $g : 0, 0);
}

# Checks to see whether the player gave the NPC a requested number of silver
sub givenSilver
{
  my $s = shift;
  
  return plugin::givenCoin(0, defined($s) ? $s : 0, 0, 0);
}

# Takes provided coins given by the player
sub takeSilver
{
  my $s = shift;
  
  return plugin::takeCoin(0, defined($s) ? $s : 0, 0, 0);
}

# Checks to see whether the player gave the NPC a requested number of copper
sub givenCopper
{
  my $c = shift;
  
  return plugin::givenCoin(defined($c) ? $c : 0, 0, 0, 0);
}

# Takes provided coins given by the player
sub takeCopper
{
  my $c = shift;
  
  return plugin::takeCoin(defined($c) ? $c : 0, 0, 0, 0);
}

# Returns any unwanted items and coins to the user with an appropriate message.
sub returnUnusedItems
{    
  my $name = plugin::assocName();

  my $itemcount = plugin::var('$itemcount');
  my $items = 0;
  
  foreach my $k (keys(%$itemcount))
  {
    next if($k == 0);
    my $r;
    
    for($r = 0; $r < $itemcount->{$k}; $r++)
    {
      $items++;
      
      quest::summonitem($k);
    }
    
    delete $itemcount->{$k};
  }
  
  if ($items > 0)
  {
    if (plugin::humanoid())
    {
      my $itemtext1 = ($items == 1) ? 'this item' : 'these items';
      my $itemtext2 = ($items == 1) ? 'it' : 'them';
      
      quest::say("I have no need for $itemtext1, $name. You can have $itemtext2 back.");
      quest::doanim(64); # Point
    }
    else
    {
      my $itemtext1 = ($items == 1) ? 'item' : 'items';
      
      quest::me("This creature has no need for the $itemtext1 you are offering.");
    }
  }
  
  my($platinum, $gold, $silver, $copper) = (plugin::val('$platinum'), plugin::val('$gold'), plugin::val('$silver'), plugin::val('$copper'));
  
  if ($platinum || $gold || $silver || $copper)
  {
    if ($items == 0) # NOTE: If $items > 0, already giving back items with message, just tack coin onto it
    {
      if ((plugin::val('$item1') == 0) && (plugin::val('$item2') == 0) && (plugin::val('$item3') == 0) && (plugin::val('$item4') == 0))
      {
        # No items, just money
        
        if (plugin::humanoid())
        {
          quest::say("I appreciate the offer, but I can't take this money, $name.");
        }
        else
        {
          quest::me('This creature has no need for your money.');
        }
      }
      else
      {
        # Items given and accepted
        
        if (plugin::humanoid())
        {
          quest::say("Here is your change, $name.");
        }
      }
    
      quest::doanim(64); # Point
    }
    
    quest::givecash($copper, $silver, $gold, $platinum);
  }
}

File: plugins\npc_tools.pl

#
# plugins\npc_tools.pl
# 
# NPC-related Helper Functions
#

# Change names like 'a_skeleton005' into 'a skeleton'
sub fixNPCName
{
  $_ = shift;
  
  s/\d+$//; # Strip trailing numeric digits
  s/\_/ /g; # Change underscores to spaces
  
  return $_;
}

# Returns 1 if the mob's race is humanoid, 0 if not. Race number argument optional, will use current NPC if omitted.
# So far mainly used to identify races that can be expected to speak to the player.
sub humanoid
{
  my $race = shift;
  
  if (!defined($race))
  {
    my $mob = plugin::var('$mob');
    
    $race = $mob->GetRace();
  }
  
  # If there's a cleaner, more efficient method of doing this, by all means...
  foreach (0..12, 15..16, 18, 23, 25, 26, 44, 55, 56, 62, 64, 67, 71, 77..79, 81, 88, 90, 92..94,
           101, 106, 110, 112, 128, 130, 131, 139, 140, 150, 151, 153, 188, 189, 236, 238, 239,
           242..244, 251, 278, 296, 299, 330..347, 385, 386, 403, 406..408, 411, 417, 433, 453,
           454, 455, 457, 458, 461, 464, 466, 467, 473, 475..478, 487..490, 495, 496..499, 520..524,
           527, 529, 532, 562..566, 568, 575, 576, 579)
  {
    return 1 if ($race == $_);
  }
  
  return 0;
}

# Associative name an NPC can use when talking to the player (friend, stranger, Dark Elf, etc.)
# Note to self: Need to implement raceid to racename sub for this
sub assocName
{
  my $faction = plugin::val('$faction');
  
  return (plugin::val('$status') > 20) ? 'boss' :
         ($faction < 3) ? plugin::val('$name') :
         ($faction < 5) ? 'friend' :
         ($faction < 7) ? 'stranger' : plugin::val('$race');
}

File: plugins\zone_tools.pl

#
# plugins\zone_tools.pl
#
# Zone-related Helper Functions
#

# Returns the city name for the current zone (or location within the zone, in some cases)
sub cityName
{
  my $zonesn = plugin::val('$zonesn');
  
  if ($zonesn eq 'gfaydark')
  {
    if (plugin::val('$y') < -1200)
    {
      return 'Felwithe';
    }
    else
    {
      return 'Kelethin';
    }
  }
  else
  {
    return plugin::val('$zoneln');
  }
}

# Returns a quick zone-appropriate greeting ("Tunare's blessings", "Bristlebane's favor", etc.)
sub quickGreeting
{
  my $zonesn = plugin::val('$zonesn');
  
  if ($zonesn eq 'gfaydark')
  {
    return plugin::random('Tunare\'s blessings', 'Hello', 'Hail', 'Welcome');
  }
  
  return plugin::random('Hail', 'Hello', 'Welcome');
}

(6) Default NPC implementations

I personally have set up some default actions for NPCs to take on my server under common circumstances.

For example...

• All NPCs will return items and coin given to them that aren't part of a quest for that NPC.
• Soulbinders will behave as expected without separate .pl files for each Soulbinder NPC
• Guards can use zone-appropriate flavor text for hails, attacking, and dying without separate .pl files for each guard
• Merchants can respond to hails with a little flavor text
• Common monster types such as orcs and goblins can have flavor text without separate .pl files for each NPC
• As a GM, I can walk up to an NPC and give code phrases for things like money to test a quest script with

Note: NPCs that do have a .pl file already created for them will need to call the plugin::defaultXYZ() sub at the end of their own subs if you wish to utilize the default event processing.

Most of the default event subs can take a true/false parameter (e.g., "defaultSay(1);" to specify that your NPC has already handled the event in question, so the default event should only do minimal processing.

File: plugins\default-npc.pl

# Global Default NPC Actions

sub EVENT_SAY
{
  plugin::defaultSay();
}

sub EVENT_ITEM
{
  plugin::defaultItem();
}

sub EVENT_COMBAT
{
  plugin::defaultCombat();
}

sub EVENT_SLAY
{
  plugin::defaultSlay();
}

sub EVENT_DEATH
{
  plugin::defaultDeath();
}

File: plugins\default-actions.pl (Still In Progress)

# Default-actions.pl
#
# Default actions to perform if the user performs particular actions on an NPC.

sub defaultSay
{
  my $handled = plugin::nullzero(shift);
  my $name = plugin::assocName();
  my $text = plugin::val('$text');
  my $mname = plugin::fixNPCName();
  my $faction = plugin::val('$faction');
  my $zonesn = plugin::val('$zonesn');
  my $npc = plugin::val('$npc');
  my $zoneln = plugin::cityName();
  
  if (!$handled)
  {
    if ($mname=~/^Soulbinder\w/)
    {
      if($text=~/^hail/i)
      {
        quest::say("Greetings, ${name}. When a hero of our world is slain, their soul returns to the place it was last bound and the body is reincarnated. As a member of the Order of Eternity, it is my duty to [bind your soul] to this location if that is your wish.");
        quest::doanim(29);

        $handled = 1;
      }
      elsif (($text=~/bind my soul/i) || ($text=~/bind your soul/i))
      {
        quest::say("Binding your soul. You will return here when you die.");
        quest::doanim(42);
        quest::selfcast(2049);

        $handled = 1;
      }
    }
    elsif ($mname=~/^Guard\w/)
    {
      if ($faction > 5)
      {
        quest::me("$mname glowers at you dubiously.");

        $handled = 1;
      }
      else
      {
        quest::say("Hail, $name! Pardon me. I am on duty, keeping $zoneln safe.");

        $handled = 1;
      }
    }
    elsif (($mname=~/^Merchant\w/) || ($mname=~/^Innkeep/) || ($mname=~/^Barkeep/))
    {
      if($text=~/^Hail/i)
      {
        quest::say("Welcome, $name! Why don't you browse through my selection of fine goods and pick out some things you like?");

        $handled = 1;
      }
    }
  }
  
  if (($text=~/test money/i) && (plugin::val('$status') > 20))
  {
    quest::givecash(99, 99, 99, 99);
  }
}

sub defaultItem
{
  plugin::returnUnusedItems();
}

sub defaultDeath
{
  my $handled = plugin::nullzero(shift);
  my $mname = plugin::val('$mname');
  my $zonesn = plugin::val('$zonesn');
  
  if (!$handled)
  {
    if ($mname =~ /^(an\_)?orc(\_.+|)$/i) # Everything from 'orc' to 'an_orc_flibberty_gibbet', but not 'orchard_master', etc.
    {
      # Orc death
      
      quest::say(
        (($zonesn =~ /(g|l)faydark/) || ($zonesn eq 'crushbone')) ? plugin::random('You shall have all the Crushbone Orcs on your tail for my death!!') :
        "DEBUG: $zonesn orc death!");

      $handled = 1;
    }
    elsif ($mname =~ /^(a\_)?gnoll(\_.+|)$/i) # Everything from 'gnoll' to 'a_gnoll_flibberty_gibbet', but not 'gnollish', etc.
    {
      # Gnoll death
      
      quest::say(
        ($zonesn =~ /^qey/i) ? plugin::random('DEBUG: Blackburrow gnoll death!!') :
        "DEBUG: $zonesn (Non-Blackburrow) gnoll death!");
      $handled = 1;
    }
    elsif ($mname =~ /^Guard/i)
    {
      # Guard death
      
      my $city = plugin::cityName();
      
      quest::say( ($city eq 'Kelethin') ? 'Kelethin guard death!' :
                  ($city eq 'Felwithe') ? 'Felwithe guard death!' :
                  "DEBUG: $city guard death!" );

      $handled = 1;
    }
  }
}

sub defaultSlay
{
  my $handled = plugin::nullzero(shift);
  my $mname = plugin::val('$mname');
  my $zonesn = plugin::val('$zonesn');
  
  if (!$handled)
  {
    if ($mname =~ /^Guard/i)
    {
      # Guard kills
      
      # 25% chance for flavor text
      if (int(rand(4)) == 0)
      {
        my $city = plugin::cityName();
      
        quest::say(
          ($city eq 'Kelethin') ? 'For the protection of all Feir\'dal, there shall be no mercy for your kind.' :
          ($city eq 'Felwithe') ? 'Another one bites the dust.' :
          "$city is a little bit safer now." );
      }

      $handled = 1;
    }
  }
}

sub defaultCombat()
{
  my $combat_state = plugin::val('$combat_state');
  my $zonesn = plugin::val('$zonesn');
  my $mname = plugin::val('$mname');
  
  if ($combat_state == 1)
  {
    if ($zonesn =~ /^((l|g)faydark|crushbone)$/)
    {
      if ($mname =~ /^(an\_)?orc(\_.+|)$/i) # Everything from 'orc' to 'an_orc_flibberty_gibbet', but not 'orchard_master', etc.
      {
      }
    }
   }
  }
  
  return;

  # Sample code to work from
  my $random_result = int(rand(100));
    if(($combat_state == 1) &&($random_result<=50)){
    quest::say("Death!!  Death to all who oppose the Crushbone orcs!!");
   }else{
   quest::say("You've ruined your lands. You'll not ruin mine!");
 }
}

(7) Real World Example

This is an example using an NPC I created to be able to change out different-sized leather pieces.

File: quests\gfaydark\Tanner_Gumry.pl

# 54501 - Tanner Gumry (Leather Armor Alterations)
# gfaydark/54 ( -130.6 -324.6 77.7 254.5 )

sub EVENT_SAY
{ 
  $name = plugin::assocName();
  my $handled = 0;
  
  if ($text=~/enlarg/i)
  {
    quest::say("If you need a piece of small or medium leather armor to be bigger, hand it to me along with 3 silver to cover materials.");
    
    $handled = 1;
  }
  elsif ($text=~/alter/i)
  {
    quest::say("If you have a piece of leather armor you need shrunk, just hand it to me and I'll take care of it for you. I can also [enlarge] leather armor pieces."); 
    quest::doanim(48); # Nod
    
    $handled = 1;
  }
  elsif ($text=~/hail/i)
  {
    quest::say("Hail, $name! If you are in need of [alterations] to your leather armor, I'm your man!");
    quest::doanim(29); # Wave
    
    $handled = 1;
  }

  plugin::defaultSay($handled);
}

sub EVENT_ITEM 
{ 
  $name = plugin::assocName();
  
  my $didWork = 1;
  
  while ($didWork)
  {
    $didWork = 0;
    
    #       leather = 2001-2012
    foreach (2001..2012)
    {
      if (plugin::takeItems($_ => 1))
      {
        if (plugin::takeSilver(3))
        {
          quest::say("Add a flap here... a layer there... and here you are, $name! Large sized!");
    
          quest::summonitem($_ + 24);
        }
        else
        {
          quest::say("A slice here and trim there... and there you are, $name! Small sized!");

          quest::summonitem($_ + 12);
        }
        
        $didWork = 1;
      }
    }
    
    # small leather = 2013-2024
    foreach (2013..2024)
    {
      if (plugin::takeItems($_ => 1))
      {
        if (plugin::takeSilver(3))
        {
          quest::say("Small stitches to preserve the strength... there you go, $name! Medium sized!");
    
          quest::summonitem($_ - 12);
        }
        else
        {
          quest::say("I can't make this any smaller! Here, take it back.");

          quest::summonitem($_);
        }
        
        $didWork = 1;
      }
    }
    
    # large leather = 2025-2036
    foreach (2025..2036)
    {
      if (plugin::takeItems($_ => 1))
      {
        if (plugin::givenSilver(3))
        {
          quest::say("I can't make this any larger! Have it back.");
    
          quest::summonitem($_);
        }
        else
        {
          quest::say("A bit off the side, tuck this in, and... here you go, $name! Medium sized!");

          quest::summonitem($_ - 24);
        }
        
        $didWork = 1;
      }
    }
  }
  
  plugin::defaultItem();
}

sub EVENT_COMBAT
{
  plugin::defaultCombat();
}

sub EVENT_SLAY
{
  plugin::defaultSlay();
}

sub EVENT_DEATH
{
  plugin::defaultDeath();
}

Conclusion

I did some of the cleanup work while I was away from home, so I haven't had a chance to 100% test everything.

If something doesn't appear to be working properly, let me know and I'll look into it!

- Shendare

[Dibalamin]

Hell yeah Shendare, thanks for sharing!

[Shendare]

UPDATE:

Missed a step in fixNPCName(). To fix the sub to have it assume the current NPC's name as the parameter if omitted, use the following version:

File: plugins\npc_tools.pl

# Change names like 'a_skeleton005' into 'a skeleton'
sub fixNPCName
{
  $_ = shift;
  
  if (!defined($_))
  {
    $_ = plugin::val('$mname');
  }
  
  s/\d+$//; # Strip trailing numeric digits
  s/\_/ /g; # Change underscores to spaces
  
  return $_;
}

Also, for Soulbinders, Merchants, and Guards default actions to work, the "\w" entries in the regular expressions should be "\s". My bad.

Finally, to clarify for those new to quest scripting, the file I referred to as "plugins\default-npc.pl" in the main post must be copied into your server's "quests" directory as "default.pl" in order to be processed on all NPCs.

- Shendare

[Shendare]

One more update, this one for the default-npcs.pl (aka default.pl).

EVENT_SLAY should be followed by EVENT_NPC_SLAY, which would call the same function:

File: quests\default.pl

sub EVENT_SLAY
{
  plugin::defaultSlay();
}

sub EVENT_NPC_SLAY
{
  plugin::defaultSlay();
}

I forgot that EVENT_SLAY is only called when an NPC kills a player. EVENT_NPC_SLAY is what's called when an NPC kills another NPC.

[cavedude]

Thank you very much for this top notch work! I sent you a PM on the PEQ forums.

[Shendare]

UDPATE: Improved npc_tools.pl

I came up with a much more efficient and extensible method for humanoid().

File: plugins\npc_tools.pl

#
# plugins\npc_tools.pl
# 
# NPC-related Helper Functions
#

# 1 = Humanoid
%raceFlags = (
  1=>1, 2=>1, 3=>1, 4=>1, 5=>1, 6=>1, 7=>1, 8=>1, 9=>1, 10=>1, 11=>1, 12=>1, 15=>1, 16=>1, 18=>1, 23=>1, 25=>1, 26=>1, 44=>1,
  55=>1, 56=>1, 62=>1, 64=>1, 67=>1, 71=>1, 77=>1, 78=>1, 79=>1, 81=>1, 88=>1, 90=>1, 92=>1, 93=>1, 94=>1,
  101=>1, 106=>1, 110=>1, 112=>1, 128=>1, 130=>1, 131=>1, 139=>1, 140=>1,
  150=>1, 151=>1, 153=>1, 188=>1, 189=>1,
  236=>1, 238=>1, 239=>1, 242=>1, 243=>1, 244=>1,
  251=>1, 278=>1, 296=>1, 299=>1,
  330=>1, 331=>1, 332=>1, 333=>1, 334=>1, 335=>1, 336=>1, 337=>1, 338=>1, 339=>1, 340=>1, 341=>1, 342=>1, 343=>1, 344=>1, 345=>1, 346=>1, 347=>1,
  385=>1, 386=>1, 
  403=>1, 406=>1, 407=>1, 408=>1, 411=>1, 417=>1, 433=>1,
  453=>1, 454=>1, 455=>1, 457=>1, 458=>1, 461=>1, 464=>1, 466=>1, 467=>1, 473=>1, 475=>1, 476=>1, 478=>1, 487=>1, 488=>1, 489=>1, 490=>1, 495=>1, 496=>1, 497=>1, 498=>1, 499=>1,
  520=>1, 521=>1, 522=>1, 523=>1, 524=>1, 527=>1, 529=>1, 532=>1,
  562=>1, 563=>1, 564=>1, 565=>1, 566=>1, 568=>1, 575=>1, 576=>1, 579=>1
);
  
# Change names like 'a_skeleton005' into 'a skeleton'
sub fixNPCName
{
  $_ = shift;
  
  if (!defined($_))
  {
    $_ = plugin::val('$mname');
  }
  
  s/\d+$//; # Strip trailing numeric digits
  s/\_/ /g; # Change underscores to spaces
  
  return $_;
}

# Returns 1 if the mob's race is humanoid, 0 if not. Race number argument optional, will use current NPC if omitted.
# So far mainly used to identify races that can be expected to speak to the player.
sub humanoid
{
  my $race = shift;
  
  if (!defined($race))
  {
    my $mob = plugin::var('$mob');
    
    $race = $mob->GetRace();
  }

  return (plugin::nullzero($raceFlags{$race}) & 1) ? 1 : 0;
}

# Associative name an NPC can use when talking to the player (friend, stranger, Dark Elf, etc.)
sub assocName
{
  my $faction = plugin::val('$faction');
  
  return (plugin::val('$status') > 20) ? 'boss' :
         ($faction < 3) ? plugin::val('$name') :
         ($faction < 5) ? 'friend' :
         ($faction < 7) ? 'stranger' : plugin::val('$race');
}