initial release
This commit is contained in:
Draqoken
441
cosmic rage/scripts/exampscript.pl
Normal file
441
cosmic rage/scripts/exampscript.pl
Normal file
@@ -0,0 +1,441 @@
|
||||
# Example of coding script routines for MUSHclient in PerlScript
|
||||
|
||||
# ----------------------------------------------------------
|
||||
# Error codes returned by various functions
|
||||
# ----------------------------------------------------------
|
||||
|
||||
my $eOK = 0; # No error
|
||||
my $eWorldOpen = 30001; # The world is already open
|
||||
my $eWorldClosed = 30002; # The world is closed, this action cannot be performed
|
||||
my $eNoNameSpecified = 30003; # No name has been specified where one is required
|
||||
my $eCannotPlaySound = 30004; # The sound file could not be played
|
||||
my $eTriggerNotFound = 30005; # The specified trigger name does not exist
|
||||
my $eTriggerAlreadyExists = 30006; # Attempt to add a trigger that already exists
|
||||
my $eTriggerCannotBeEmpty = 30007; # The trigger "match" string cannot be empty
|
||||
my $eInvalidObjectLabel = 30008; # The name of this object is invalid
|
||||
my $eScriptNameNotLocated = 30009; # Script name is not in the script file
|
||||
my $eAliasNotFound = 30010; # The specified alias name does not exist
|
||||
my $eAliasAlreadyExists = 30011; # Attempt to add a alias that already exists
|
||||
my $eAliasCannotBeEmpty = 30012; # The alias "match" string cannot be empty
|
||||
my $eCouldNotOpenFile = 30013; # Unable to open requested file
|
||||
my $eLogFileNotOpen = 30014; # Log file was not open
|
||||
my $eLogFileAlreadyOpen = 30015; # Log file was already open
|
||||
my $eLogFileBadWrite = 30016; # Bad write to log file
|
||||
my $eTimerNotFound = 30017; # The specified timer name does not exist
|
||||
my $eTimerAlreadyExists = 30018; # Attempt to add a timer that already exists
|
||||
my $eVariableNotFound = 30019; # Attempt to delete a variable that does not exist
|
||||
my $eCommandNotEmpty = 30020; # Attempt to use SetCommand with a non-empty command window
|
||||
my $eBadRegularExpression = 30021; # Bad regular expression syntax
|
||||
my $eTimeInvalid = 30022; # Time given to AddTimer is invalid
|
||||
my $eBadMapItem = 30023; # Direction given to AddToMapper is invalid
|
||||
my $eNoMapItems = 30024; # No items in mapper
|
||||
my $eUnknownOption = 30025; # Option name not found
|
||||
my $eOptionOutOfRange = 30026; # New value for option is out of range
|
||||
my $eTriggerSequenceOutOfRange = 30027; # Trigger sequence value invalid
|
||||
my $eTriggerSendToInvalid = 30028; # Where to send trigger text to is invalid
|
||||
my $eTriggerLabelNotSpecified = 30029; # Trigger label not specified/invalid for 'send to variable'
|
||||
my $ePluginFileNotFound = 30030; # File name specified for plugin not found
|
||||
my $eProblemsLoadingPlugin = 30031; # There was a parsing or other problem loading the plugin
|
||||
my $ePluginCannotSetOption = 30032; # Plugin is not allowed to set this option
|
||||
my $ePluginCannotGetOption = 30033; # Plugin is not allowed to get this option
|
||||
my $eNoSuchPlugin = 30034; # Requested plugin is not installed
|
||||
my $eNotAPlugin = 30035; # Only a plugin can do this
|
||||
my $eNoSuchRoutine = 30036; # Plugin does not support that subroutine (subroutine not in script)
|
||||
my $ePluginDoesNotSaveState = 30037; # Plugin does not support saving state
|
||||
my $ePluginCouldNotSaveState = 30037; # Plugin could not save state (eg. no state directory)
|
||||
my $ePluginDisabled = 30039; # Plugin is currently disabled
|
||||
my $eErrorCallingPluginRoutine = 30040; # Could not call plugin routine
|
||||
my $eCommandsNestedTooDeeply = 30041; # Calls to "Execute" nested too deeply
|
||||
my $eCannotCreateChatSocket = 30042; # Unable to create socket for chat connection
|
||||
my $eCannotLookupDomainName = 30043; # Unable to do DNS (domain name) lookup for chat connection
|
||||
my $eNoChatConnections = 30044; # No chat connections open
|
||||
my $eChatPersonNotFound = 30045; # Requested chat person not connected
|
||||
my $eBadParameter = 30046; # General problem with a parameter to a script call
|
||||
my $eChatAlreadyListening = 30047; # Already listening for incoming chats
|
||||
my $eChatIDNotFound = 30048; # Chat session with that ID not found
|
||||
my $eChatAlreadyConnected = 30049; # Already connected to that server/port
|
||||
my $eClipboardEmpty = 30050; # Cannot get (text from the) clipboard
|
||||
my $eFileNotFound = 30051; # Cannot open the specified file
|
||||
my $eAlreadyTransferringFile = 30052; # Already transferring a file
|
||||
my $eNotTransferringFile = 30053; # Not transferring a file
|
||||
my $eNoSuchCommand = 30054; # There is not a command of that name
|
||||
my $eArrayAlreadyExists = 30055; # That array already exists
|
||||
my $eBadKeyName = 30056; # That name is not permitted for a key
|
||||
my $eArrayDoesNotExist = 30056; # That array does not exist
|
||||
my $eArrayNotEvenNumberOfValues = 30057; # Values to be imported into array are not in pairs
|
||||
my $eImportedWithDuplicates = 30058; # Import succeeded, however some values were overwritten
|
||||
my $eBadDelimiter = 30059; # Import/export delimiter must be a single character, other than backslash
|
||||
my $eSetReplacingExistingValue = 30060; # Array element set, existing value overwritten
|
||||
my $eKeyDoesNotExist = 30061; # Array key does not exist
|
||||
my $eCannotImport = 30062; # Cannot import because cannot find unused temporary character
|
||||
|
||||
|
||||
# ----------------------------------------------------------
|
||||
# Flags for AddTrigger
|
||||
# ----------------------------------------------------------
|
||||
|
||||
my $eEnabled = 1; # enable trigger
|
||||
my $eOmitFromLog = 2; # omit from log file
|
||||
my $eOmitFromOutput = 4; # omit trigger from output
|
||||
my $eKeepEvaluating = 8; # keep evaluating
|
||||
my $eIgnoreCase = 16; # ignore case when matching
|
||||
my $eTriggerRegularExpression = 32; # trigger uses regular expression
|
||||
my $eExpandVariables = 512; # expand variables like @direction
|
||||
my $eReplace = 1024; # replace existing trigger of same name
|
||||
my $eTemporary = 16384; # temporary - do not save to world file
|
||||
|
||||
# ----------------------------------------------------------
|
||||
# Colours for AddTrigger
|
||||
# ----------------------------------------------------------
|
||||
|
||||
my $NOCHANGE = -1;
|
||||
my $custom1 = 0;
|
||||
my $custom2 = 1;
|
||||
my $custom3 = 2;
|
||||
my $custom4 = 3;
|
||||
my $custom5 = 4;
|
||||
my $custom6 = 5;
|
||||
my $custom7 = 6;
|
||||
my $custom8 = 7;
|
||||
my $custom9 = 8;
|
||||
my $custom10 = 9;
|
||||
my $custom11 = 10;
|
||||
my $custom12 = 11;
|
||||
my $custom13 = 12;
|
||||
my $custom14 = 13;
|
||||
my $custom15 = 14;
|
||||
my $custom16 = 15;
|
||||
|
||||
# ----------------------------------------------------------
|
||||
# Flags for AddAlias
|
||||
# ----------------------------------------------------------
|
||||
|
||||
# my $eEnabled = 1; # same as for AddTrigger
|
||||
my $eIgnoreAliasCase = 32; # ignore case when matching
|
||||
my $eOmitFromLogFile = 64; # omit this alias from the log file
|
||||
my $eAliasRegularExpression = 128; # alias is regular expressions
|
||||
# my $eExpandVariables = 512; # same as for AddTrigger
|
||||
# my $eReplace = 1024; # same as for AddTrigger
|
||||
my $eAliasSpeedWalk = 2048; # interpret send string as a speed walk string
|
||||
my $eAliasQueue = 4096; # queue this alias for sending at the speedwalking delay interval
|
||||
my $eAliasMenu = 8192; # this alias appears on the alias menu
|
||||
my $eTemporary = 16384; # temporary - do not save to world file
|
||||
|
||||
# ----------------------------------------------------------
|
||||
# Flags for AddTimer
|
||||
# ----------------------------------------------------------
|
||||
|
||||
# my $eEnabled = 1; # same as for AddTrigger
|
||||
my $eAtTime = 2; # if not set, time is "every"
|
||||
my $eOneShot = 4; # if set, timer only fires once
|
||||
my $eTimerSpeedWalk = 8; # timer does a speed walk when it fires
|
||||
my $eTimerNote = 16; # timer does a world.note when it fires
|
||||
my $eActiveWhenClosed = 32; # timer fires even when world is disconnected
|
||||
# my $eReplace = 1024; # same as for AddTrigger
|
||||
# my $eTemporary = 16384; # same as for AddTrigger
|
||||
|
||||
# ----------------------------------------------------------
|
||||
# Example showing iterating through all triggers with labels
|
||||
# ----------------------------------------------------------
|
||||
|
||||
sub showtriggers
|
||||
{
|
||||
foreach $item (Win32::OLE::in ($world->GetTriggerList))
|
||||
{
|
||||
$world->note($item);
|
||||
}
|
||||
} # end of showtriggers
|
||||
|
||||
|
||||
# -----------------------------------------------
|
||||
# Example showing iterating through all variables
|
||||
# ------------------------------------------------
|
||||
|
||||
sub showvariables
|
||||
{
|
||||
foreach $item (Win32::OLE::in ($world->GetVariableList))
|
||||
{
|
||||
($key, $value) = ($item, $world->GetVariable ($item));
|
||||
$world->note($key . " = " . $value) if (defined ($key));
|
||||
}
|
||||
} # end of showvariables
|
||||
|
||||
|
||||
# ----------------------------------------------------------
|
||||
# Example showing iterating through all aliases with labels
|
||||
# ----------------------------------------------------------
|
||||
|
||||
sub showaliases
|
||||
{
|
||||
foreach $item (Win32::OLE::in ($world->GetAliasList))
|
||||
{
|
||||
$world->note($item);
|
||||
}
|
||||
} # end of showaliases
|
||||
|
||||
|
||||
# ---------------------------------------------------------
|
||||
# Example showing running a script on world open
|
||||
# ---------------------------------------------------------
|
||||
sub OnWorldOpen
|
||||
{
|
||||
$world->note ("---------- World Open ------------");
|
||||
} # end of OnWorldOpen
|
||||
|
||||
# ---------------------------------------------------------
|
||||
# Example showing running a script on world close
|
||||
# ---------------------------------------------------------
|
||||
sub OnWorldClose
|
||||
{
|
||||
$world->note ("---------- World Close ------------");
|
||||
} # end of OnWorldClose
|
||||
|
||||
# ---------------------------------------------------------
|
||||
# Example showing running a script on world connect
|
||||
# ---------------------------------------------------------
|
||||
sub OnWorldConnect
|
||||
{
|
||||
$world->note ("---------- World Connect ------------");
|
||||
} # end of OnWorldConnect
|
||||
|
||||
# ---------------------------------------------------------
|
||||
# Example showing running a script on world disconnect
|
||||
# ---------------------------------------------------------
|
||||
sub OnWorldDisconnect
|
||||
{
|
||||
$world->note ("---------- World Disconnect ------------");
|
||||
} # end of OnWorldDisconnect
|
||||
|
||||
|
||||
# ---------------------------------------------------------
|
||||
# Example showing running a script on an alias
|
||||
#
|
||||
# This script is designed to be called by an alias: ^teleport(.*)$
|
||||
#
|
||||
# This alias SHOULD have "regular expression" checked.
|
||||
#
|
||||
# It is for teleporting (going to) a room by number
|
||||
#
|
||||
# The room is entered by name and looked up in the variables
|
||||
# list.
|
||||
# ---------------------------------------------------------
|
||||
sub OnTeleport
|
||||
{
|
||||
|
||||
my ($thename, $theoutput, $wildcards) = @_;
|
||||
|
||||
$sDestination = $world->trim ($world->GetAliasInfo ($thename, 101));
|
||||
|
||||
# if nothing entered echo possible destinations
|
||||
|
||||
if ($sDestination eq "")
|
||||
{
|
||||
$world->note ("-------- TELEPORT destinations ----------");
|
||||
|
||||
foreach $item (Win32::OLE::in ($world->GetVariableList()))
|
||||
{
|
||||
($key, $value) = ($item, $world->GetVariable ($item));
|
||||
if (substr ($key, 0, 9) eq "teleport_")
|
||||
{
|
||||
$sHelp .= ", " if ($sHelp ne "");
|
||||
$sHelp .= substr ($key, 9);
|
||||
}
|
||||
}
|
||||
|
||||
# if no destinations found, tell them
|
||||
|
||||
$sHelp = "<no rooms in teleport list>" if ($sHelp eq "");
|
||||
$world->note ($sHelp);
|
||||
return;
|
||||
} # no destination supplied
|
||||
|
||||
# get contents of the destination variable
|
||||
|
||||
$iRoom = $world->GetVariable ("teleport_" . lc ($sDestination));
|
||||
|
||||
# if not found, or invalid name, that isn't in the list
|
||||
if (!defined ($iRoom))
|
||||
{
|
||||
$world->note ("******** Destination $sDestination unknown *********");
|
||||
return;
|
||||
}
|
||||
|
||||
$world->note ("------> Teleporting to $sDestination");
|
||||
$world->send ("\@teleport #$iRoom");
|
||||
|
||||
} # end of OnTeleport
|
||||
|
||||
# ---------------------------------------------------------
|
||||
# Example showing running a script on an alias
|
||||
#
|
||||
# This script is designed to be called by an alias: ^add_teleport(|\s*(\w*)\s*(\d*))$
|
||||
#
|
||||
# This alias SHOULD have "regular expression" checked.
|
||||
#
|
||||
# It is for adding a room to the list of rooms to teleport to (by
|
||||
# the earlier script).
|
||||
#
|
||||
# eg. ADD_TELEPORT dungeon 1234
|
||||
#
|
||||
# ---------------------------------------------------------
|
||||
sub OnAddTeleport
|
||||
{
|
||||
my ($thename, $theoutput, $wildcards) = @_;
|
||||
|
||||
# wildcard 2 is the room name
|
||||
|
||||
$sDestination = $world->trim ($world->GetAliasInfo ($thename, 102));
|
||||
|
||||
# if nothing entered tell them command syntax
|
||||
if ($sDestination eq "")
|
||||
{
|
||||
$world->note ("Syntax: add_teleport name dbref");
|
||||
$world->note (" eg. add_teleport LandingBay 4421");
|
||||
return;
|
||||
}
|
||||
|
||||
# wildcard 3 is where to go to
|
||||
|
||||
$iRoom = $world->trim ($world->GetAliasInfo ($thename, 103));
|
||||
|
||||
# add room and destination location to variable list
|
||||
$iStatus = $world->SetVariable ("teleport_$sDestination", $iRoom);
|
||||
|
||||
if ($iStatus != 0)
|
||||
{
|
||||
$world->note ("Room name must be alphabetic, you entered: $sDestination");
|
||||
return;
|
||||
}
|
||||
|
||||
$world->note ("Teleport location $sDestination (#$iRoom) added to teleport list");
|
||||
|
||||
} # end of OnAddTeleport
|
||||
|
||||
|
||||
# ------------------------------------------
|
||||
# Example showing a script called by a timer
|
||||
# -------------------------------------------
|
||||
sub OnTimer
|
||||
{
|
||||
my ($strTimerName) = @_;
|
||||
|
||||
$world->note ("Timer $strTimerName has fired!");
|
||||
} # end of OnTimer
|
||||
|
||||
# --------------------------------------------
|
||||
# Example showing a script called by a trigger
|
||||
# Should be connected to a trigger matching on: <*hp *m *mv>*
|
||||
# (the above example will work for SMAUG default prompts (eg. <100hp 10m 40mv>)
|
||||
# it may need to be changed depending on the MUD prompt format).
|
||||
# --------------------------------------------
|
||||
sub OnStats
|
||||
{
|
||||
my ($strTriggerName, $trig_line, $wildcards) = @_;
|
||||
|
||||
$iHP = $world->GetTriggerInfo ($strTriggerName, 101);
|
||||
$iMana = $world->GetTriggerInfo ($strTriggerName, 102);
|
||||
$iMV = $world->GetTriggerInfo ($strTriggerName, 103);
|
||||
|
||||
$world->Note ("Your HP are $iHP");
|
||||
$world->Note ("Your Mana is $iMana");
|
||||
$world->Note ("Your movement points are $iMV");
|
||||
|
||||
} # end of OnStats
|
||||
|
||||
|
||||
|
||||
# --------------------------------------------
|
||||
# Subroutine to be called to repeat a command.
|
||||
#
|
||||
# Call from the alias: ^#(\d+)\s+(.+)$
|
||||
# Regular Expression: checked
|
||||
#
|
||||
# Example of use: #10 give sword to Trispis
|
||||
# This would send "give sword to Trispis" 10 times
|
||||
# --------------------------------------------
|
||||
sub OnRepeat
|
||||
{
|
||||
my ($thename, $theoutput, $wildcards) = @_;
|
||||
|
||||
$iCount = $world->GetAliasInfo ($thename, 101); # count of times
|
||||
$iCommand = $world->GetAliasInfo ($thename, 102); # what to send
|
||||
|
||||
for ($i = 1; $i <= $iCount; $i++)
|
||||
{
|
||||
$world->Send ($iCommand);
|
||||
}
|
||||
} # end of OnRepeat
|
||||
|
||||
|
||||
|
||||
# --------------------------------------------
|
||||
# Example showing iterating through all worlds
|
||||
# --------------------------------------------
|
||||
|
||||
sub showworlds
|
||||
{
|
||||
foreach $item (Win32::OLE::in ($world->GetWorldList))
|
||||
{
|
||||
$world->note($item);
|
||||
}
|
||||
|
||||
} # end of showworlds
|
||||
|
||||
# --------------------------------------------------
|
||||
# Example showing sending a message to another world
|
||||
# --------------------------------------------------
|
||||
|
||||
sub SendToWorld
|
||||
{
|
||||
my ($name, $message) = @_;
|
||||
|
||||
my $otherworld;
|
||||
|
||||
$otherworld = $world->getworld ($name);
|
||||
|
||||
if (!defined ($otherworld))
|
||||
{
|
||||
$world->note("World " . $name . " is not open");
|
||||
return;
|
||||
}
|
||||
|
||||
$otherworld->send($message);
|
||||
|
||||
}
|
||||
|
||||
# --------------------------------------------
|
||||
# Example trigger routine that just shows what was passed to it
|
||||
# --------------------------------------------
|
||||
|
||||
sub ExampleTrigger
|
||||
{
|
||||
my ($thename, $theoutput, @$wildcards) = @_;
|
||||
|
||||
$world->note ("Trigger " . $thename . " fired.");
|
||||
$world->note ("Matching line was: " . $theoutput);
|
||||
|
||||
for ($i = 1; $i <= 10; $i++)
|
||||
{
|
||||
$wildcard = $world->GetTriggerInfo ($thename, 100 + $i);
|
||||
$world->note ("Wildcard $i = $wildcard");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# --------------------------------------------
|
||||
# Subroutine to be called remember which way you walked.
|
||||
#
|
||||
# Call from the alias: keypad-*
|
||||
# Send: %1
|
||||
#
|
||||
# --------------------------------------------
|
||||
sub OnKeypadDirection
|
||||
{
|
||||
my ($thename, $theoutput, $wildcards) = @_;
|
||||
|
||||
$Direction = $world->GetAliasInfo ($thename, 101);
|
||||
$world->setvariable("direction", $Direction);
|
||||
}
|
||||
|
||||
$world->note ("Scripting enabled - script file processed");
|
||||
|
||||
Reference in New Issue
Block a user