Games-Axmud
view release on metacpan or search on metacpan
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'region' model object (which represents an area of the
# world)
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the region, e.g. 'woodlands' (NB If $name is longer than 32
# characters, it is shortened)
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parentRegion - World model number of the region to which this region belongs ('undef'
# if there isn't a parent region or it this is a non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parentRegion, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'region');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parentRegion;
$self->{childHash} = {};
$self->{concreteFlag} = FALSE;
$self->{aliveFlag} = FALSE;
$self->{sentientFlag} = FALSE;
$self->{portableFlag} = FALSE;
$self->{saleableFlag} = FALSE;
$self->{privateHash} = {};
# No group 2 IVs for regions
# No group 3 IVs for regions
# No group 4 IVs for regions
# Set group 5 IVs
# Flag set to TRUE if this region is temporary, in which case Axmud deletes it (and
# everything it contains) at the end of the current session, or if that's not possible, at
# the beginning of the next one
$self->{tempRegionFlag} = FALSE;
# Flag set to TRUE if he user has marked this region as 'finished'. Note that temporary
# regions can't be marked as finished
$self->{finishedFlag} = FALSE;
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
sub countChildren {
# Called by GA::Cmd::ModelReport->do
# Counts the number of rooms in this region (actually, counts the number of child
# GA::ModelObj::Room objects)
# Counts the number of non-room objects in this region (actually, counts the number of
# children which aren't room objects, and the number of children of rooms which aren't
# GA::Obj::Exit objects). Makes a separate count of child regions which aren't included
# in the main count
# Counts the number of exits in this region (actually, counts the number of child
# room objects, then counts the number of exits that each of those rooms has)
#
# Expected arguments
# $session - The calling function's GA::Session
#
# Return values
# An empty list on improper arguments
# Otherwise, returns the counts as a list in the form
# (room_count, exit_count, other_count, child_region_count)
my ($self, $session, $check) = @_;
# Local variables
my (
$roomCount, $exitCount, $otherCount, $childRegionCount,
@emptyList,
);
# Check for improper arguments
if (! defined $session || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->countChildren', @_);
return @emptyList;
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
# $session - The parent GA::Session (not stored as an IV)
# $descrip - A string to describe the room - the same as its room title, if that's
# available; if not, a shortened version of the verbose description
# (NB as of v1.1.408, the $descrip is no longer stored anywhere)
# $mode - 'model' for an room model object (stored in
# GA::Obj::WorldModel->modelHash), 'non_model' for non-model room
# object, for example one used by the Locator task, or 'global' for
# the room object stored in the global variable $DEFAULT_ROOM (and
# which provides default values for all room object IVs)
#
# Optional arguments
# $parentRegion - World model number of the region to which this room belongs ('undef'
# if there isn't a parent region or it this is a non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $descrip, $mode, $parentRegion, $check) = @_;
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $descrip || ! defined $mode
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
# For very large world models (10,000+ rooms), some computers tend to run out of memory
# which produces a Perl error and a crash
# In response, we try to reduce the size of the world model as much as possible. Most of the
# memory used is for room objects and exit objects (GA::Obj::Exit). Most of the memory
# used by each of those objects is for IVs with default values
# Therefore, we remove most of the IVs altogether, restoring them only if some part of the
# Axmud code sets the IV to a non-default value. Default values for each IV are obtained
# from a room object stored in a global variable, $DEFAULT_ROOM, instead of from the room
# object itself
my $self;
if ($mode eq 'global') {
# This object is to be stored in the global variable, $DEFAULT_ROOM. Therefore it has
# default values for all IVs
# Set standard IVs
$self->{_objName} = 'room';
$self->{_objClass} = $class;
$self->{_parentFile} = undef;
$self->{_parentWorld} = undef;
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{name} = 'room';
$self->{category} = 'room';
$self->{modelFlag} = FALSE;
$self->{number} = undef;
$self->{parent} = $parentRegion;
$self->{childHash} = {};
$self->{concreteFlag} = FALSE;
$self->{aliveFlag} = FALSE;
$self->{sentientFlag} = FALSE;
$self->{portableFlag} = FALSE;
$self->{saleableFlag} = FALSE;
$self->{privateHash} = {};
$self->{sourceCodePath} = undef;
$self->{notesList} = [];
# No group 2 IVs for rooms
# No group 3 IVs for rooms
# No group 4 IVs for rooms
# Set group 5 IVs
# The room's position in the map - specifically, its coordinates on the regionmap grid
# tied to this room's parent region
$self->{xPosBlocks} = undef;
$self->{yPosBlocks} = undef;
$self->{zPosBlocks} = undef;
# The room's tag, if it has been given one. Maximum 16 characters, and cannot contain
# the sequence '@@@', which is needed for route objects
$self->{roomTag} = undef;
# The offset (in pixels) where the room tag is drawn on the map. (0, 0) means draw the
# tag at the standard position; (10, -10) means draw it 10 pixels to the right, 10
# pixels higher
$self->{roomTagXOffset} = 0;
$self->{roomTagYOffset} = 0;
# The name of the guild, if this is a guild room ('undef' if all guilds can advance
# skills here)
$self->{roomGuild} = undef;
# The offset (in pixels) where the guild name is drawn on the map
$self->{roomGuildXOffset} = 0;
$self->{roomGuildYOffset} = 0;
# When we move north from room A to a new room B, and when room B has an exit in the
# opposite direction, room A's departure exit is drawn as an 'uncertain' exit - we can
# definitely move north from A to B, and probably move south from B to A
# Until this is confirmed - at which point room A's departure exit becomes a one-way
# exit or a two-way exit - room B doesn't know that it has been set as the room A's
# departure exit's ->destinationRoom
# This is a problem because, if room B is deleted, room A's departure exit still points
# to the deleted room
# This room object is room B, and this hash IV contains a list of room A departure
# exits - uncertain exits - which lead here. The hash is in the form
# $uncertainExitHash{room_A_exit_number} = room_B_opposite_exit_number
# When an uncertain exit is created, the exit's destination room - this object - is told
# to update the hash
# When an uncertain exit becomes a two-way exit, the entry is deleted
$self->{uncertainExitHash} = {};
# We have the same issue with one-way exits. If we move north from room A to a new room
# B, when room B doesn't have an exit in the opposite direction, room A's departure
# exit is drawn as a '1-way' exit
# If room B is deleted, the one-way exit still points to it; if room B is moved to a new
# place in the same region, the automapper will still try to draw a one-way exit
# between them
# This room object is room B, and this hash IV contains a list of room A departure exits
# - one-way exits - which lead here. The hash is in the form
# $oneWayExitHash{room_A_exit_number} = undef
# When an one-way exit is created, the exit's destination room - this object - is told
# to update the hash
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
# Set standard IVs
# $self->{_objName} = 'room';
# $self->{_objClass} = $class;
$self->{_parentFile} = undef;
$self->{_parentWorld} = undef;
# $self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
# $self->{category} = 'room';
$self->{modelFlag} = FALSE;
$self->{number} = undef; # Set later
$self->{parent} = undef;
# Set group 5 IVs
$self->{xPosBlocks} = undef;
$self->{yPosBlocks} = undef;
$self->{zPosBlocks} = undef;
}
# Bless the object into existence
bless $self, $class;
return $self;
}
sub compress {
# Called by GA::Obj::File->updateExtractedData and GA::Cmd::CompressModel->do
# Drastically reduce the amount of memory used by each exit object by completely removing
# IVs whose values are the default values for an exit object (the code obtains the
# default values from the exit object stored in the global variable $DEFAULT_EXIT,
# instead)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my %hash;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->compress', @_);
}
# Deal with universal IVs
foreach my $iv ( qw (_objName _objClass _privFlag) ) {
delete $self->{$iv};
}
# Deal with flag scalars which are FALSE by default
foreach my $iv (
qw (
concreteFlag aliveFlag sentientFlag portableFlag saleableFlag unspecifiedFlag
currentlyDarkFlag exclusiveFlag
)
) {
if (exists $self->{$iv} && ! $self->{$iv}) {
delete $self->{$iv};
}
}
# Deal with non-flag scalars which are undefined by default
foreach my $iv (
qw (
sourceCodePath roomTag roomGuild lastRoomFlag virtualAreaPath
)
) {
if (exists $self->{$iv} && ! defined $self->{$iv}) {
delete $self->{$iv};
}
}
# Deal with non-flag scalars which have a defined value by default
%hash = (
'name' => 'room',
'category' => 'room',
'roomTagXOffset' => 0,
'roomTagYOffset' => 0,
'roomGuildXOffset' => 0,
'roomGuildYOffset' => 0,
'wildMode' => 'normal',
);
foreach my $iv (keys %hash) {
if (exists $self->{$iv} && $self->{$iv} eq $hash{$iv}) {
delete $self->{$iv};
}
}
# Deal with lists which are empty by default
foreach my $iv (
qw (
notesList titleList unspecifiedPatternList sortedExitList failExitPatternList
specialDepartPatternList roomCmdList tempRoomCmdList tempObjList nounList adjList
arriveScriptList
)
) {
if (exists $self->{$iv}) {
my $listRef = $self->{$iv};
if (! @$listRef) {
delete $self->{$iv};
}
}
}
# Deal with hashes which are empty by default
foreach my $iv (
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
# Operation complete
return 1;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# To conserve memory, IVs with default values don't exist in the blessed reference; instead, we
# obtain them from a default room object stored in the global variable $DEFAULT_ROOM
sub _objName {
if ( ! exists $_[0]->{_objName} )
{ $axmud::DEFAULT_ROOM->{_objName} } else { $_[0]->{_objName} }
}
sub _objClass {
if ( ! exists $_[0]->{_objClass} )
{ $axmud::DEFAULT_ROOM->{_objClass} } else { $_[0]->{_objClass} }
}
sub _parentFile
{ $_[0]->{_parentFile} }
sub _parentWorld
{ $_[0]->{_parentWorld} }
sub _privFlag {
if ( ! exists $_[0]->{_privFlag} )
{ $axmud::DEFAULT_ROOM->{_privFlag} } else { $_[0]->{_privFlag} }
}
# Group 1 IVs
sub name {
if ( ! exists $_[0]->{name} )
{ $axmud::DEFAULT_ROOM->{name} } else { $_[0]->{name} }
}
sub category {
if ( ! exists $_[0]->{category} )
{ $axmud::DEFAULT_ROOM->{category} } else { $_[0]->{category} }
}
sub modelFlag
{ $_[0]->{modelFlag} }
sub number
{ $_[0]->{number} }
sub parent
{ $_[0]->{parent} }
sub childHash {
my $self = shift;
if ( ! exists $self->{childHash} )
{ return %{$axmud::DEFAULT_ROOM->{childHash}}; }
else
{ return %{$self->{childHash}}; }
}
sub concreteFlag {
if ( ! exists $_[0]->{concreteFlag} )
{ $axmud::DEFAULT_ROOM->{concreteFlag} } else { $_[0]->{concreteFlag} }
}
sub aliveFlag {
if ( ! exists $_[0]->{aliveFlag} )
{ $axmud::DEFAULT_ROOM->{aliveFlag} } else { $_[0]->{aliveFlag} }
}
sub sentientFlag {
if ( ! exists $_[0]->{sentientFlag} )
{ $axmud::DEFAULT_ROOM->{sentientFlag} } else { $_[0]->{sentientFlag} }
}
sub portableFlag {
if ( ! exists $_[0]->{portableFlag} )
{ $axmud::DEFAULT_ROOM->{portableFlag} } else { $_[0]->{portableFlag} }
}
sub saleableFlag {
if ( ! exists $_[0]->{saleableFlag} )
{ $axmud::DEFAULT_ROOM->{saleableFlag} } else { $_[0]->{saleableFlag} }
}
sub privateHash {
my $self = shift;
if ( ! exists $self->{privateHash} )
{ return %{$axmud::DEFAULT_ROOM->{privateHash}}; }
else
{ return %{$self->{privateHash}}; }
}
sub sourceCodePath {
if ( ! exists $_[0]->{sourceCodePath} )
{ $axmud::DEFAULT_ROOM->{sourceCodePath} } else { $_[0]->{sourceCodePath} }
}
sub notesList {
my $self = shift;
if ( ! exists $self->{notesList} )
{ return @{$axmud::DEFAULT_ROOM->{notesList}}; }
else
{ return @{$self->{notesList}}; }
}
# Group 5 IVs
sub xPosBlocks
{ $_[0]->{xPosBlocks} }
sub yPosBlocks
{ $_[0]->{yPosBlocks} }
sub zPosBlocks
{ $_[0]->{zPosBlocks} }
sub roomTag {
if ( ! exists $_[0]->{roomTag} )
{ $axmud::DEFAULT_ROOM->{roomTag} } else { $_[0]->{roomTag} }
}
sub roomTagXOffset {
if ( ! exists $_[0]->{roomTagXOffset} )
{ $axmud::DEFAULT_ROOM->{roomTagXOffset} } else { $_[0]->{roomTagXOffset} }
}
sub roomTagYOffset {
if ( ! exists $_[0]->{roomTagYOffset} )
{ $axmud::DEFAULT_ROOM->{roomTagYOffset} } else { $_[0]->{roomTagYOffset} }
}
sub roomGuild {
if ( ! exists $_[0]->{roomGuild} )
{ $axmud::DEFAULT_ROOM->{roomGuild} } else { $_[0]->{roomGuild} }
}
sub roomGuildXOffset {
if ( ! exists $_[0]->{roomGuildXOffset} )
{ $axmud::DEFAULT_ROOM->{roomGuildXOffset} } else { $_[0]->{roomGuildXOffset} }
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
# use diagnostics;
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'weapon' model object
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the weapon, e.g. 'sword' - usually the same as $self->noun
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the room where this object is found, the shop from
# which it can be bought or the NPC from which it is liberated ('undef'
# if there is no parent object or it this is a non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'weapon');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = FALSE;
$self->{sentientFlag} = FALSE;
$self->{portableFlag} = TRUE;
$self->{saleableFlag} = TRUE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# No group 3 IVs for weapons
# Set group 4 IVs (but leave other IVs set to their default values)
$self->{explicitFlag} = TRUE;
$self->{fixableFlag} = TRUE;
$self->{sellableFlag} = TRUE;
# No group 5 IVs for weapons
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# Group 5 IVs (none for this object)
}
{ package Games::Axmud::ModelObj::Armour;
use strict;
use warnings;
# use diagnostics;
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'armour' model object
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the armour, e.g. 'shield' - usually the same as $self->noun
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the room where this object is found, the shop from
# which it can be bought or the NPC from which it is liberated ('undef'
# if there is no parent object or it this is a non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'armour');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = FALSE;
$self->{sentientFlag} = FALSE;
$self->{portableFlag} = TRUE;
$self->{saleableFlag} = TRUE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# No group 3 IVs for armours
# Set group 4 IVs (but leave other IVs set to their default values)
$self->{explicitFlag} = TRUE;
$self->{fixableFlag} = TRUE;
$self->{sellableFlag} = TRUE;
# No group 5 IVs for armours
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# Group 5 IVs (none for this object)
}
{ package Games::Axmud::ModelObj::Garment;
use strict;
use warnings;
# use diagnostics;
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'garment' model object
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the garment, e.g. 'shirt' - usually the same as $self->noun
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the room where this object is found, the shop from
# which it can be bought or the NPC from which it is liberated ('undef'
# if there is no parent object or it this is a non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'garment');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = FALSE;
$self->{sentientFlag} = FALSE;
$self->{portableFlag} = TRUE;
$self->{saleableFlag} = TRUE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# No group 3 IVs for garments
# Set group 4 IVs (but leave other IVs set to their default values)
$self->{explicitFlag} = TRUE;
$self->{fixableFlag} = TRUE;
$self->{sellableFlag} = TRUE;
# No group 5 IVs for garments
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# Group 5 IVs (none for this object)
}
{ package Games::Axmud::ModelObj::Char;
use strict;
use warnings;
# use diagnostics;
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'character' model object (which represents a character on
# the world which isn't the one you're using at the moment)
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - The character's name (absolute max 32 chars)
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the parent object; probably never used, but the
# parent could conceivably be a 'custom' model object
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
# Special check (for character and minion objects only) - name must not be longer than 32
# chars
if (! $axmud::CLIENT->nameCheck($name, 32)) {
return $session->writeError('Illegal name \'' . $name . '\'', $class . '->new');
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'char');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = TRUE;
$self->{sentientFlag} = TRUE;
$self->{portableFlag} = FALSE;
$self->{saleableFlag} = FALSE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# Group 3 IVs - use default values
# No group 4 IVs for characters
# Set group 5 IVs
# The character's guild, if known ('undef' if not)
$self->{guild} = undef;
# The character's race, if known ('undef' if not)
$self->{race} = undef;
# Flag set to TRUE if this character is owned by you, FALSE if it is owned by someone else
$self->{ownCharFlag} = FALSE;
# A string representing the owner of the character. Can be set to anything - the owner's
# real-life name, or their nickname, or the name of their main character. Characters owned
# by you can also have this set to anything - 'me' or 'HandsomeKing', etc
$self->{owner} = undef;
# What sort of character is this? ('mortal' for an ordinary character, 'wiz' for any kind of
# admin, immortal or coder, 'test' for one of the world's official playtesting characters
# at the world, if they're allowed)
$self->{mortalStatus} = 'mortal';
# Diplomatic status
# Can mark this character as 'friendly', 'neutral' or 'hostile'
$self->{diplomaticStatus} = 'neutral';
# Flag set to TRUE if this character has ever attacked one of yours, FALSE if not
$self->{grudgeFlag} = FALSE;
# What to do, if this character attacks you. Flag set to TRUE for 'fight', FALSE for 'run
# away'
$self->{fightBackFlag} = FALSE;
# The character's level (if known exactly, 0 if not)
$self->{level} = 0;
# If the exact level isn't known, a level for which the character is definitely stronger
# (approximate)
$self->{weakerLevel} = 0;
# If the exact level isn't known, a level for which the character is definitely weaker
# (approximate)
$self->{strongerLevel} = 0;
# Other info about the character, if known ('undef' if not)
$self->{totalXP} = undef;
$self->{totalQP} = undef;
# List of quests the character has completed (if known)
$self->{questList} = [];
# What the character was carrying, last time they were seen (just a simple list of strings
# - not linked to model objects)
$self->{inventoryList} = [];
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
# Constructors
sub new {
# Prepare a new instance of the 'minion' model object (which represents a non-player
# character directly controlled - at the moment, or in general - by a character)
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - The minion's name (absolute max 32 chars)
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the parent object; probably never used, but the
# parent could conceivably be a 'custom' model object
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
# Special check (for character and minion objects only) - name must not be longer than 32
# chars
if (! $axmud::CLIENT->nameCheck($name, 32)) {
return $session->writeError('Illegal name \'' . $name . '\'', $class . '->new');
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'minion');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = TRUE;
$self->{sentientFlag} = TRUE; # Minions are made sentient by default
$self->{portableFlag} = FALSE;
$self->{saleableFlag} = FALSE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# Group 3 IVs - use default values
# No group 4 IVs for minions
# Set group 5 IVs
# The minion's guild, if known ('undef' if not)
$self->{guild} = undef;
# The minion's race, if known ('undef' if not)
$self->{race} = undef;
# Flag set to TRUE if this minion is owned by you, FALSE if it is owned by someone else
$self->{ownMinionFlag} = FALSE;
# The minion's level (if known exactly, 0 if not)
$self->{level} = 0;
# If the exact level isn't known, a level for which the minion is definitely stronger
# (approximate)
$self->{weakerLevel} = 0;
# If the exact level isn't known, a level for which the minion is definitely weaker
# (approximate)
$self->{strongerLevel} = 0;
# What the minion was carrying, last time they were seen (just a simple list of strings -
# not linked to model objects)
$self->{inventoryList} = [];
# The cost of acquiring this minion (if it can be bought), in the world profile's standard
# currency unit
$self->{value} = 0;
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# Group 5 IVs
sub guild
{ $_[0]->{guild} }
sub race
{ $_[0]->{race} }
sub ownMinionFlag
{ $_[0]->{ownMinionFlag} }
sub level
{ $_[0]->{level} }
sub weakerLevel
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'sentient' model object (representing an NPC capable of
# language, at least in theory)
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the sentient, e.g. 'guard' - usually the same as $self->noun
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the room where this object is found or the region in
# which it wanders ('undef' if there is no parent object or it this is a
# non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'sentient');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = TRUE;
$self->{sentientFlag} = TRUE;
$self->{portableFlag} = FALSE;
$self->{saleableFlag} = FALSE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# Group 3 IVs - use default values
# No group 4 IVs for sentients
# Set group 5 IVs
# The sentient's guild, if known ('undef' if not)
$self->{guild} = undef,
# The sentient's race, if known ('undef' if not)
$self->{race} = undef,
# Flag set to TRUE if the sentient has ever said anything, FALSE if not
$self->{talkativeFlag} = FALSE;
# List of things the sentient has said (a list of strings)
$self->{talkList} = [];
# Flag set to TRUE if the sentient has ever been noticed performing an action, FALSE if not
$self->{actionFlag} = FALSE;
# List of text received when the sentient performs an action
$self->{actionList} = [];
# Flag set to TRUE if the sentient has ever initiated combat, FALSE if not
$self->{unfriendlyFlag} = FALSE;
# Whether the sentient is 'good', 'evil' or 'neutral' (default is neutral)
$self->{morality} = 'neutral';
# Flag set to TRUE if the sentient tends to wander around of its own volition, FALSE if not
$self->{wanderFlag} = FALSE;
# Flag set to TRUE if the sentient has ever fleed combat, FALSE if not
$self->{fleeFlag} = FALSE;
# Flag set to TRUE if the sentient tends to flee combat quickly, FALSE if not
$self->{quickFleeFlag} = FALSE;
# Flag set to TRUE if this sentient should NEVER be attacked, FALSE if not
$self->{noAttackFlag} = FALSE;
# Flag set to TRUE if this sentient mercies, rather than kills, its opponents; FALSE if not
$self->{mercyFlag} = FALSE;
# The name of the quest with which this sentient is associated ('undef' if no quest)
$self->{questName} = undef;
# The sentient's level (if known exactly, 0 if not)
$self->{level} = 0;
# If the exact level isn't known, a level for which the sentient is definitely stronger
# (approximate)
$self->{weakerLevel} = 0;
# If the exact level isn't known, a level for which the sentient is definitely weaker
# (approximate)
$self->{strongerLevel} = 0;
# What the sentient was carrying, last time it was seen (just a simple list of strings
# - not linked to model objects)
$self->{inventoryList} = [];
# Every time the sentient's cash is stolen, the amount is entered into this list (until the
# list contains ten entries) - from this, the average amount of cash carried by the
# sentient can be generated
$self->{cashList} = [];
# Bless the object into existence
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'creature' model object (representing an NPC not capable of
# language, at least in theory)
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the creature, e.g. 'spider' - usually the same as $self->noun
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the room where this object is found or the region in
# which it wanders ('undef' if there is no parent object or it this is a
# non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'creature');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = TRUE;
$self->{sentientFlag} = FALSE;
$self->{portableFlag} = FALSE;
$self->{saleableFlag} = FALSE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# Group 3 IVs - use default values
# No group 4 IVs for creatures
# Set group 5 IVs
# The creature's guild, if known ('undef' if not)
$self->{guild} = undef,
# The creature's race, if known ('undef' if not)
$self->{race} = undef,
# Flag set to TRUE if the creature has ever been noticed performing an action, FALSE if not
$self->{actionFlag} = FALSE;
# List of text received when the creature performs an action
$self->{actionList} = [];
# Flag set to TRUE if the creature has ever initiated combat, FALSE if not
$self->{unfriendlyFlag} = FALSE;
# Whether the creature is 'good', 'evil' or 'neutral' (default is neutral)
$self->{morality} = 'neutral';
# Flag set to TRUE if the creature tends to wander around of its own volition, FALSE if not
$self->{wanderFlag} = FALSE;
# Flag set to TRUE if the creature has ever fleed combat, FALSE if not
$self->{fleeFlag} = FALSE;
# Flag set to TRUE if the creature tends to flee combat quickly, FALSE if not
$self->{quickFleeFlag} = FALSE;
# Flag set to TRUE if this creature should NEVER be attacked, FALSE if not
$self->{noAttackFlag} = FALSE;
# Flag set to TRUE if this creature mercies, rather than kills, its opponents; FALSE if not
$self->{mercyFlag} = FALSE;
# The name of the quest with which this creature is associated ('undef' if no quest)
$self->{questName} = undef;
# The creature's level (if known exactly, 0 if not)
$self->{level} = 0;
# If the exact level isn't known, a level for which the creature is definitely stronger
# (approximate)
$self->{weakerLevel} = 0;
# If the exact level isn't known, a level for which the creature is definitely weaker
# (approximate)
$self->{strongerLevel} = 0;
# What the creature was carrying, last time it was seen (just a simple list of strings
# - not linked to model objects)
$self->{inventoryList} = [];
# Every time the creature's cash is stolen, the amount is entered into this list (until the
# list contains ten entries) - from this, the average amount of cash carried by the
# creature can be generated
$self->{cashList} = [];
# Bless the object into existence
bless $self, $class;
return $self;
}
lib/Games/Axmud/ModelObj.pm view on Meta::CPAN
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'portable' model object (representing any object that can be
# picked up, at least in theory, and which isn't a weapon, armour or garment)
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the portable, e.g. 'bucket' - usually the same as $self->noun
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the room where this object is found, the shop from
# which it can be bought or the NPC from which it is liberated ('undef'
# if there is no parent object or it this is a non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'portable');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = FALSE;
$self->{sentientFlag} = FALSE;
$self->{portableFlag} = TRUE;
$self->{saleableFlag} = TRUE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# No group 3 IVs for portables
# Set group 4 IVs (but leave other IVs set to their default values)
$self->{explicitFlag} = TRUE;
$self->{fixableFlag} = FALSE;
$self->{sellableFlag} = TRUE;
# Set group 5 IVs
# The object's type (matches a portable type in the dictionary object)
$self->{type} = 'other';
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# Group 5 IVs
sub type
{ $_[0]->{type} }
}
{ package Games::Axmud::ModelObj::Decoration;
use strict;
use warnings;
# use diagnostics;
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'decoration' model object (representing any object that
# can't be picked up, at least in theory, but which can be interacted with)
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the decoration, e.g. 'curtain' - usually the same as
# $self->noun
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the room where this object is found ('undef' if
# there is no parent object or it this is a non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'decoration');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs
$self->{parent} = $parent;
$self->{childHash} = {};
$self->{concreteFlag} = TRUE;
$self->{aliveFlag} = FALSE;
$self->{sentientFlag} = FALSE;
$self->{portableFlag} = FALSE;
$self->{saleableFlag} = FALSE;
$self->{privateHash} = {};
# Set group 2 IVs (but leave other IVs set to their default values)
$self->{noun} = $name;
# No group 3 IVs for decorations
# Set group 4 IVs (but leave other IVs set to their default values)
$self->{explicitFlag} = FALSE;
$self->{fixableFlag} = FALSE;
$self->{sellableFlag} = FALSE;
# Set group 5 IVs
# The object's type (matches a decoration type in the dictionary object)
$self->{type} = 'other';
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# Group 5 IVs
sub type
{ $_[0]->{type} }
}
{ package Games::Axmud::ModelObj::Custom;
use strict;
use warnings;
# use diagnostics;
use Glib qw(TRUE FALSE);
our @ISA = qw(Games::Axmud::Generic::ModelObj Games::Axmud);
##################
# Constructors
sub new {
# Prepare a new instance of the 'custom' model object (which can represent any concept)
#
# Expected arguments
# $session - The parent GA::Session (not stored as an IV)
# $name - A name for the custom object, e.g. 'big_idea'
# $modelFlag - TRUE if this is a model object, FALSE if it's a non-model object
#
# Optional arguments
# $parent - World model number of the parent object ('undef' if there is no parent
# object or it this is a non-model object)
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $name, $modelFlag, $parent, $check) = @_;
# Local variables
my ($parentFile, $parentProf);
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $name || ! defined $modelFlag
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
if ($modelFlag) {
$parentFile = 'worldmodel';
$parentProf = $session->currentWorld->name;
}
# Setup
my $self = Games::Axmud::Generic::ModelObj->new($session, $name, 'custom');
# Set standard IVs
$self->{_objName} = $name;
$self->{_objClass} = $class;
$self->{_parentFile} = $parentFile; # May be 'undef'
$self->{_parentWorld} = $parentProf; # May be 'undef'
$self->{_privFlag} = FALSE, # All IVs are public
# Set group 1 IVs (most should be set separately for each instance of this object)
$self->{parent} = $parent;
$self->{childHash} = {};
# $self->{concreteFlag} = FALSE;
# $self->{aliveFlag} = FALSE;
# $self->{sentientFlag} = FALSE;
# $self->{portableFlag} = FALSE;
# $self->{saleableFlag} = FALSE;
# $self->{privateHash} = {};
# Group 2 IVs - use default values
# No group 3 IVs for custom model objects
# Group 4 IVs - use default values
# No group 5 IVs for custom model objects
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
##################
# Accessors - set
##################
# Accessors - get
# Group 5 IVs (none for this object)
}
# Package must return a true value
1
( run in 2.156 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )