Games-Axmud
view release on metacpan or search on metacpan
lib/Games/Axmud/Generic.pm view on Meta::CPAN
#
# Expected arguments
# $session - The calling function's GA::Session
# $inputString - What the player actually typed (e.g. ';k orcs');
# $standardCmd - The standard version of the command (i.e. 'kill')
# $multipleFlag - Flag set to FALSE when called by ';kill' (e.g. attack a single orc),
# set to TRUE when called by ';kkill' (e.g. attack all orcs at current
# location)
# @targetList - A list of target strings specified by the user, e.g. ('orcs', 'wolf')
#
# Return values
# 'undef' on improper arguments or failure
# 1 on success
my ($self, $session, $inputString, $standardCmd, $multipleFlag, @targetList) = @_;
# Local variables
my @objList;
# Check for improper arguments
if (
! defined $session || ! defined $inputString || ! defined $standardCmd
|| ! defined $multipleFlag
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->killLimitedTargets', @_);
}
# This command requires the Locator task to know the current location
if (! $session->locatorTask) {
return $self->error(
$session, $inputString,
'Cannot kill - Locator task isn\'t running',
);
} elsif (! $session->locatorTask->roomObj) {
return $self->error(
$session, $inputString,
'Cannot kill - Locator task doesn\'t know the current location',
);
}
if (! @targetList) {
# Get the first target from the Locator's list of things in the current room
@objList = $session->locatorTask->roomObj->tempObjList;
if (! @objList) {
return $self->complete(
$session, $standardCmd,
'Cannot kill - current location is empty',
);
} else {
# Choose the first minion, sentient or creature in @objList
OUTER: foreach my $obj (@objList) {
if (
$obj->aliveFlag
&& (
($obj->category eq 'minion' && ! $obj->ownMinionFlag)
|| $obj->category eq 'sentient'
|| $obj->category eq 'creature'
)
) {
push (@targetList, $obj->noun);
last OUTER;
}
}
}
# If no suitable objects were found, don't attack
if (! @targetList) {
return $self->complete(
$session, $standardCmd,
'Cannot kill - no enemy minions, sentients or creatures at the current'
. ' location',
);
}
}
# Attack the targets
foreach my $target (@targetList) {
$session->sendModCmd('kill', 'victim', $target);
}
if (scalar @targetList == 1) {
return $self->complete($session, $standardCmd, 'Attacking 1 target');
} else {
return $self->complete(
$session, $standardCmd,
'Attacking ' . scalar @targetList . ' targets',
);
}
}
sub killUnlimitedTargets {
# Called by GA::Cmd::KillAll->do and KillMall->do
# Attacks all targets (or all non-player targets) at current location
#
# Expected arguments
# $session - The calling function's GA::Session
# $inputString - What the player actually typed (e.g. ';ka');
# $standardCmd - The standard version of the command (i.e. 'killall')
# $playerFlag - Set to TRUE if player targets should be attacked too; FALSE if only
# non-player targets should be attacked
#
# Return values
# 'undef' on improper arguments or failure
# 1 on success
my ($self, $session, $inputString, $standardCmd, $playerFlag, $check) = @_;
# Local variables
my (@objList, @targetList);
# Check for improper arguments
if (
! defined $session || ! defined $inputString || ! defined $standardCmd
|| ! defined $playerFlag || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->killUnlimitedTargets', @_);
}
# This command requires the Locator task to know the current location
if (! $session->locatorTask) {
return $self->error(
$session, $inputString,
'Cannot kill - Locator task isn\'t running',
);
} elsif (! $session->locatorTask->roomObj) {
return $self->error(
$session, $inputString,
'Cannot kill - Locator task doesn\'t know the current location',
);
}
# Get a list of attackable targets from the Locator's list of things in the current room
@objList = $session->locatorTask->roomObj->tempObjList;
if (! @objList) {
return $self->complete(
$session, $standardCmd,
'Cannot kill - current location is empty',
);
} else {
foreach my $obj (@objList) {
if (
$obj->aliveFlag
&& (
($playerFlag && $obj->category eq 'char')
|| ($obj->category eq 'minion' && ! $obj->ownMinionFlag)
|| $obj->category eq 'sentient'
|| $obj->category eq 'creature'
)
) {
push (@targetList, $obj->noun);
}
}
}
# Attack the targets
foreach my $target (@targetList) {
$session->sendModCmd('kill', 'victim', $target);
}
if (scalar @targetList == 1) {
return $self->complete($session, $standardCmd, 'Attacking 1 target');
} else {
return $self->complete(
$session, $standardCmd,
'Attacking ' . scalar @targetList . ' targets',
);
}
}
sub interactLimitedTargets {
# Called by GA::Cmd::Kill->do and Kkill->do
# Attacks a list of targets limited to the given arguments, e.g. ('orc') or ('orcs',
# 'troll', 'bears'), but doesn't attack players
#
# Expected arguments
# $session - The calling function's GA::Session
# $inputString - What the player actually typed (e.g. ';k orcs');
# $standardCmd - The standard version of the command (i.e. 'kill')
# $multipleFlag - Flag set to FALSE when called by ';interact' (e.g. attack a single
# orc), set to TRUE when called by ';iinteract' (e.g. attack all orcs
# at current location)
# @targetList - A list of target strings specified by the user, e.g. ('orcs', 'wolf')
#
# Return values
# 'undef' on improper arguments or failure
# 1 on success
my ($self, $session, $inputString, $standardCmd, $multipleFlag, @targetList) = @_;
# Local variables
my @objList;
# Check for improper arguments
if (
! defined $session || ! defined $inputString || ! defined $standardCmd
|| ! defined $multipleFlag
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->interactLimitedTargets', @_);
}
# This command requires the Locator task to know the current location
if (! $session->locatorTask) {
return $self->error(
$session, $inputString,
'Cannot interact - Locator task isn\'t running',
);
} elsif (! $session->locatorTask->roomObj) {
return $self->error(
$session, $inputString,
'Cannot interact - Locator task doesn\'t know the current location',
);
}
if (! @targetList) {
# Get the first target from the Locator's list of things in the current room
@objList = $session->locatorTask->roomObj->tempObjList;
if (! @objList) {
return $self->complete(
$session, $standardCmd,
'Cannot interact - current location is empty',
);
} else {
# Choose the first minion, sentient or creature in @objList
OUTER: foreach my $obj (@objList) {
if (
$obj->aliveFlag
&& (
($obj->category eq 'minion' && ! $obj->ownMinionFlag)
|| $obj->category eq 'sentient'
|| $obj->category eq 'creature'
)
) {
push (@targetList, $obj->noun);
last OUTER;
}
}
}
# If no suitable objects were found, don't attack
if (! @targetList) {
return $self->complete(
$session, $standardCmd,
'Cannot interact - no enemy minions, sentients or creatures at the current'
. ' location',
);
}
}
# Attack the targets
foreach my $target (@targetList) {
$session->sendModCmd('interact', 'victim', $target);
}
if (scalar @targetList == 1) {
return $self->complete($session, $standardCmd, 'Interacting with 1 target');
} else {
return $self->complete(
$session, $standardCmd,
'Interacting with ' . scalar @targetList . ' targets',
);
}
}
sub interactUnlimitedTargets {
# Called by GA::Cmd::KillAll->do and KillMall->do
# Attacks all targets (or all non-player targets) at current location
#
# Expected arguments
# $session - The calling function's GA::Session
# $inputString - What the player actually typed (e.g. ';ia');
# $standardCmd - The standard version of the command (i.e. 'interactall')
# $playerFlag - Set to TRUE if player targets should be attacked too; FALSE if only
# non-player targets should be attacked
#
# Return values
# 'undef' on improper arguments or failure
# 1 on success
my ($self, $session, $inputString, $standardCmd, $playerFlag, $check) = @_;
# Local variables
my (@objList, @targetList);
# Check for improper arguments
if (
! defined $session || ! defined $inputString || ! defined $standardCmd
|| ! defined $playerFlag || defined $check
) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->interactUnlimitedTargets',
@_,
);
}
# This command requires the Locator task to know the current location
if (! $session->locatorTask) {
return $self->error(
$session, $inputString,
'Cannot kill - Locator task isn\'t running',
);
} elsif (! $session->locatorTask->roomObj) {
return $self->error(
$session, $inputString,
'Cannot kill - Locator task doesn\'t know the current location',
);
}
# Get a list of attackable targets from the Locator's list of things in the current room
@objList = $session->locatorTask->roomObj->tempObjList;
if (! @objList) {
return $self->complete(
$session, $standardCmd,
'Cannot kill - current location is empty',
);
} else {
foreach my $obj (@objList) {
if (
$obj->aliveFlag
&& (
($playerFlag && $obj->category eq 'char')
|| ($obj->category eq 'minion' && ! $obj->ownMinionFlag)
|| $obj->category eq 'sentient'
|| $obj->category eq 'creature'
)
) {
push (@targetList, $obj->noun);
}
}
}
# Attack the targets
foreach my $target (@targetList) {
$session->sendModCmd('interact', 'victim', $target);
}
if (scalar @targetList == 1) {
return $self->complete($session, $standardCmd, 'Interacting 1 target');
} else {
return $self->complete(
$session, $standardCmd,
'Interacting with ' . scalar @targetList . ' targets',
);
}
}
# Extract switches
sub extractProfileSwitches {
# Called by $self->addInterface, ->modifyInterface, ->deleteInterface
# Extracts the group 1 switch options for the commands ';addtrigger', ';modifytrigger' and
# ';deletetrigger' (etc), namely -w, -r, -g, -c, -x <category>, -d <profile>
#
# Expected arguments
# $session - The calling function's GA::Session
# $inputString - What the user originally typed
# $category - 'trigger', 'alias', 'macro', 'timer' or 'hook'
# $action - What is to be done with the interface: 'add', 'modify', 'export',
# 'import' or 'delete'. Used to set the error message, if any
#
# Optional arguments
# @args - List of group 1 switch options arguments extracted from $inputString
# (maybe be an empty list)
#
# Return values
# Returns an empty list on improper arguments or on failure
# Otherwise, returns a list in the form...
# ($profCount, $profCategory, $profName, @args)
# ...where $profCount is set to 0, if no profiles were found, and @args now contains fewer
# (or the same arguments), depending on how many switch options were removed
my ($self, $session, $inputString, $category, $action, @args) = @_;
# Local variables
lib/Games/Axmud/Generic.pm view on Meta::CPAN
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
# Check that $category is valid
if (! $axmud::CLIENT->ivExists('constModelTypeHash', $category)) {
return $axmud::CLIENT->writeError(
'Invalid model object category \'' . $category . '\'',
$class . '->new',
);
}
# If $name is longer than 32 characters, shorten it (and add an ellipsis)
if (length ($name) > 32) {
$name = substr($name, 0, 29) . '...';
}
# Setup
my $self = {
_objName => $name,
_objClass => $class,
_parentFile => undef, # Set by the calling function
_parentWorld => undef, # Set by the calling function
_privFlag => FALSE, # All IVs are public
# NB If any of these IVs are changed, GA::Generic::ModelObj->convertCategory must be
# changed, too
# Group 1 IVs (all objects)
# -------------------------
# The object's actual name, e.g. 'orc' (can include spaces)
name => $name,
# What kind of object this is ('char', 'portable', 'custom' etc)
category => $category,
# Flag set to TRUE if this object is in $session's world model (in which case, the
# object is a 'model object')
# Flag set to FALSE if this object is not in $session's world model (in which case, the
# object is a 'non-model object')
# All objects which call this function have their ->modelFlag set to FALSE, initially
modelFlag => FALSE,
# For model objects, a unique number ('undef' for non-model objects)
number => undef,
# Number of the model object of the room where this object is found, the shop where this
# object is bought, the NPC from which this object is liberated, or the region in
# which this object wanders ('undef' for non-model objects, or if there is nothing
# resembling a parent)
parent => undef,
# Hash of numbers of model objects for which this is the ->parent. Hash in the form
# $childHash{number} = 'undef'
childHash => {},
# These variables are the same for each kind of object (the same for all weapons, the
# same for all decorations, etc)
# Flag set to FALSE if this object is an abstract concept ('region' and 'room', possibly
# 'custom'), TRUE if this object is a concrete thing (everything else, possibly
# including 'custom')
concreteFlag => FALSE,
# Flag set to TRUE if this object is alive, FALSE if not
aliveFlag => FALSE,
# Flag set to TRUE if this object is sentient (capable of speech, in theory), FALSE if
# not
sentientFlag => FALSE,
# Flag set to TRUE if the object can be carried (in theory), FALSE if not
portableFlag => FALSE,
# Flag set to TRUE if the object can be bought and sold (in theory), FALSE if not
saleableFlag => FALSE,
# Private properties for this object, in a customisable hash
privateHash => {},
# If the world's source code is available on the user's computer (i.e. the world model
# object's ->mudlibPath IV is set), and if the file matching this object is known,
# the path to that file (relative to the directory stored in ->mudLibPath)
sourceCodePath => undef,
# Notes on this object, if the user wants to add them. Each value in the list is a
# separate line for display
notesList => [],
};
# Group 2 IVs (all objects except 'region' and 'room')
# ----------------------------------------------------
if ($category ne 'region' && $category ne 'room') {
# A word string most likely to be the main noun (usually a single word, e.g. 'sword')
$self->{noun} = undef,
# A possible description of the object. For example, with 'a huge hairy orc', possible
# noun tags include 'orc', 'hairy orc', 'huge hairy orc' and 'huge hairy orc'
# Is set as required; the default setting is the same as $self->noun
$self->{nounTag} = undef,
# List of other words which are known to be nouns for this object
$self->{otherNounList} = [],
# List of other words which are known to be adjectives describing this object
$self->{adjList} = [],
# List of pseudo-adjectives (single words like 'suspicious' reduced from a longer string
# like 'slightly suspicious-looking') describing this object
$self->{pseudoAdjList} = [],
# List of root adjectives describing this object (for languages that use declined
# adjectives; English isn't one of them)
$self->{rootAdjList} = [],
# Words describing the object which aren't known nouns or adjectives
$self->{unknownWordList} = [],
# A number representing how many there of this object there are; usually set to 1
$self->{multiple} = 1,
# How the object appears in verbose room descriptions, minus any initial articles
$self->{baseString} = undef,
# Description for the object, if known (e.g. 'A magnificent gleaming sword, perfect for
# chopping up trolls')
$self->{descrip} = undef,
# Two IVs for non-model objects used with the Inventory task (set to 'undef' when used
# by anything else)
# If this object is contained in another one, the model number of the container
$self->{container} = undef,
# How this object is possessed ('wield', 'hold', 'wear', 'carry', 'sack', 'misc')
$self->{inventoryType} = undef,
}
# Group 3 IVs ('character', 'minion', 'sentient', 'creature' and optionally 'custom')
# -----------------------------------------------------------------------------------
# (Group 3 IVs are for available for use in any code you write to handle attacks)
if (
$category eq 'character' || $category eq 'minion' || $category eq 'sentient'
|| $category eq 'creature' || $category eq 'custom'
) {
# The current status of the fight with this object:
# 'waiting' - the fight hasn't started yet (but will soon)
# 'alive' - the target is alive
# 'kill' - the target is dead
# 'flee' - the target has run away in a direction that can be followed
# 'escape' - the target has run away, and can't be pursued for some reason
# The current status of the interaction with this object:
# 'waiting' - the interaction hasn't started yet (but will soon)
# 'interact' - the target is interacting (and alive)
# 'finish' - the interaction has finished
# 'flee' - the target has run away in a direction that can be followed
# 'escape' - the target has run away, and can't be pursued for some reason
$self->{targetStatus} = undef;
# What kind of attack this attack: 'fight' for a fight, and 'interaction' for an
# interaction
$self->{targetType} = undef;
# For targets who move after a fight starts. The path from the original location to the
# target's presumed current location, e.g. 'n;nw;w'
$self->{targetPath} = undef;
# For targets who move after a fight starts. The target's presumed location in the
# world (the world model number of a room). Set to 'undef' if unknown
$self->{targetRoomNum} = undef;
# Is the object listed separately when the user types a look/glance command, or is it
# only apparent that the object exists from a description of something else? (Group 4
# IV for inanimate objects)
# Flag set to TRUE if the object is listed separately, FALSE if not
$self->{explicitFlag} = TRUE;
# Flag that can be set to TRUE, if your code needs to remember which objects in a room
# have been attacked
$self->{alreadyAttackedFlag}
= FALSE;
}
# Group 4 IVs ('weapon', 'armour', 'garment', 'portable', 'decoration', optionally 'custom')
# ------------------------------------------------------------------------------------------
if (
$category eq 'weapon' || $category eq 'armour' || $category eq 'garment'
|| $category eq 'portable' || $category eq 'decoration' || $category eq 'custom'
) {
# Is the object listed separately when the user types a look/glance command, or is it
# only apparent that the object exists from a description of something else? (Group 3
# IV for living beings)
# Flag set to TRUE if the object is listed separately, FALSE if not
$self->{explicitFlag} = TRUE;
# Object's weight (if known)
$self->{weight} = undef;
# Character's stat bonuses or penalties when using this object
$self->{bonusHash} = {};
# Condition of the object (a number in the range 0-100; 'undef' if unknown, or if not
# used in this world)
$self->{condition} = undef;
# The Condition task uses this flag to help it set an object's current condition
$self->{conditionChangeFlag}
= FALSE;
# Flag set to TRUE if this object is fixable/repairable), FALSE if not (or if unknown)
$self->{fixableFlag} = FALSE;
# Flag set to TRUE if sellable, FALSE if not (or if unknown). This flag tells you
# whether this particular object can be sold; $self->saleableFlag, a group 1 IV, tells
# you whether objects of this ->category can be sold, or not)
$self->{sellableFlag} = FALSE;
# The highest value of the object that's been noticed when buying it ('undef' if value
# unknown)
$self->{buyValue} = undef;
# The highest value of the object that's been noticed when selling it ('undef' if value
# unknown)
$self->{sellValue} = undef;
# Flag set to TRUE if this object can only be used by certain guilds, races or indeed
# characters
$self->{exclusiveFlag} = FALSE;
# A hash of guilds, races, named chars etc allowed to use this object. Hash in the form
# ->exclusionHash{profile_name) = undef
$self->{exclusiveHash} = {};
}
# The generic model object is never actually blessed into existence
return $self;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# Group 1 IVs (all objects)
sub name
{ $_[0]->{name} }
sub category
{ $_[0]->{category} }
sub modelFlag
{ $_[0]->{modelFlag} }
sub number
{ $_[0]->{number} }
sub parent
{ $_[0]->{parent} }
sub childHash
{ my $self = shift; return %{$self->{childHash}}; }
sub concreteFlag
{ $_[0]->{concreteFlag} }
sub aliveFlag
{ $_[0]->{aliveFlag} }
sub sentientFlag
{ $_[0]->{sentientFlag} }
sub portableFlag
{ $_[0]->{portableFlag} }
sub saleableFlag
{ $_[0]->{saleableFlag} }
sub privateHash
{ my $self = shift; return %{$self->{privateHash}}; }
sub sourceCodePath
{ $_[0]->{sourceCodePath} }
sub notesList
{ my $self = shift; return @{$self->{notesList}}; }
# Group 2 IVs (all objects except 'region' and 'room')
sub noun
{ $_[0]->{noun} }
sub nounTag
{ $_[0]->{nounTag} }
sub otherNounList
{ my $self = shift; return @{$self->{otherNounList}}; }
sub adjList
{ my $self = shift; return @{$self->{adjList}}; }
sub pseudoAdjList
{ my $self = shift; return @{$self->{pseudoAdjList}}; }
sub rootAdjList
{ my $self = shift; return @{$self->{rootAdjList}}; }
sub unknownWordList
{ my $self = shift; return @{$self->{unknownWordList}}; }
sub multiple
{ $_[0]->{multiple} }
sub baseString
{ $_[0]->{baseString} }
sub descrip
{ $_[0]->{descrip} }
sub container
{ $_[0]->{container} }
sub inventoryType
{ $_[0]->{inventoryType} }
# Group 3 IVs ('character', 'minion', 'sentient', 'creature' and optionally 'custom')
sub targetStatus
{ $_[0]->{targetStatus} }
sub targetType
{ $_[0]->{targetType} }
sub targetPath
{ $_[0]->{targetPath} }
sub targetRoomNum
{ $_[0]->{targetRoomNum} }
sub explicitFlag
{ $_[0]->{explicitFlag} } # Also a group 4 IV
sub alreadyAttackedFlag
{ $_[0]->{alreadyAttackedFlag} }
# Group 4 IVs ('weapon', 'armour', 'garment', 'portable', 'decoration', optionally 'custom')
# sub explicitFlag
( run in 1.588 second using v1.01-cache-2.11-cpan-39bf76dae61 )