Games-Axmud
view release on metacpan or search on metacpan
lib/Games/Axmud/WizWin.pm view on Meta::CPAN
sub textViewSignalConnect {
# Called by several functions
# Extracts the data from a textview buffer (added with $self->addTextView). Splits it
# into lines of text, removes leading/trailing whitespace, and stores the result in one
# of this object's list IVs
# (Code used is very similar to the ->signal_connect in GA::Generic::EditWin->addTextView)
#
# Expected arguments
# $buffer - The Gtk3::TextView's buffer
# $iv - The list IV in which the lines should be stored
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $buffer, $iv, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->textViewSignalConnect', @_);
}
$buffer->signal_connect('changed' => sub {
my (
$text,
@list, @finalList,
);
$text = $axmud::CLIENT->desktopObj->bufferGetText($buffer);
# Split the contents of the textview into a list of lines, separated by newline
# characters
@list = split("\n", $text);
# Remove any empty lines and leading/trailing whitespace
foreach my $line (@list) {
if ($line) {
$line =~ s/^\s*//; # Remove leading whitespace
$line =~ s/\s*$//; # Remove trailing whitepsace
(push @finalList, $line);
}
}
# Set the IV
$self->ivPoke($iv, @finalList);
# Update the hash of changed IVs
$self->ivAdd('ivChangeHash', $iv, TRUE);
});
return 1;
}
sub updateTextView {
# Called by $self->analysisPage and later pages
# Fills a Gtk3::TextView with the lines in a single component
#
# Expected arguments
# $textView - The Gtk3::TextView to fill up
# $component - The component to use - a key in $self->analysisHash
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $textView, $component, $check) = @_;
# Local variables
my (
$textViewBuffer, $listRef,
@bufferObjList, @stringList,
);
# Check for improper arguments
if (! defined $textView || ! defined $component || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->updateTextView', @_);
}
$textViewBuffer = $textView->get_buffer();
# If $component doesn't exist as a key in $self->analysisHash - meaning that the user
# didn't allocate any lines to this component - just make sure the textview is empty
if (! $self->ivExists('analysisHash', $component)) {
$textViewBuffer->set_text('');
} else {
$listRef = $self->ivShow('analysisHash', $component);
foreach my $line (@$listRef) {
my $textViewBufferObj = $self->ivIndex('bufferObjList', $line);
push (@stringList, $textViewBufferObj->modLine);
}
$textViewBuffer->set_text(join("\n", @stringList));
}
return 1;
}
sub eliminateUndefsFromList {
# Called by several functions which use values from key-value pairs in the hashes
# $self->customPrimaryDirHash and ->customPrimaryAbbrevHash, in which the values might be
# set to 'undef'
# Given a list of elements, eliminates all those which are set to 'undef', and returns
# the modified list
# e.g. in the list ('north', 'south', undef, undef, 'east'), returns
# ('north', 'south', 'east')
lib/Games/Axmud/WizWin.pm view on Meta::CPAN
$self->ivAdd('profUpdateHash', $iv, $listRef);
return 1;
}
sub profileUpdatePushSort {
# Called by $self->analysisPage and analyseComponent
# Companion to $self->profileUpdatePush, called for delimiter lists which need to be
# sorted, longest first
#
# Expected arguments
# $iv - A list IV (a key in $self->profUpdateHash)
#
# Optional arguments
# @itemList - A list of items to add to the corresponding value in $self->profUpdateHash
# (can be an empty list)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $iv, @itemList) = @_;
# Local variables
my $listRef;
# Check for improper arguments
if (! defined $iv) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->profileUpdatePush', @_);
}
if ($self->ivExists('profUpdateHash', $iv)) {
$listRef = $self->ivShow('profUpdateHash', $iv);
}
OUTER: foreach my $newItem (@itemList) {
INNER: foreach my $oldItem (@$listRef) {
if ($newItem eq $oldItem) {
# Don't add the duplicate
next OUTER;
}
}
# Not a duplicate
push (@$listRef, $newItem);
}
@$listRef = sort {length($b) <=> length($a)} (@$listRef);
$self->ivAdd('profUpdateHash', $iv, $listRef);
return 1;
}
sub updateProfileList {
# Called by $self->saveChanges
#
# Updates a world profile list IV with new values, preserving any existing ones. However,
# duplicate values are not added
#
# Expected arguments
# $profObj - The current world profile
# $iv - An IV in the current world profile
#
# Optional arguments
# @list - A list of values to add to the list IV (if an empty list, no values are
# added)
#
# Return values
# 'undef' on improper arguments or if @list is empty
# 1 otherwise
my ($self, $profObj, $iv, @list) = @_;
# Local variables
my @profList;
# Check for improper arguments
if (! defined $profObj || ! defined $iv) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->updateProfileList', @_);
}
# If @list is empty, there's nothing to do
if (! @list) {
return undef;
}
# Import the contents of the profile's IV (for convenience)
@profList = $profObj->$iv;
# Update the list
OUTER: foreach my $item (@list) {
INNER: foreach my $profItem (@profList) {
if ($item eq $profItem) {
# Don't add the duplicate
next OUTER;
}
}
# Not a duplicate
push (@profList, $item);
}
# Store the new contents of the IV
$profObj->ivPoke($iv, @profList);
return 1;
}
lib/Games/Axmud/WizWin.pm view on Meta::CPAN
$count++;
$name = $type . '_' . $count;
# Check that the world profile doesn't have an existing component with this name
if ($self->session->currentWorld->ivExists('componentHash', $name)) {
$flag = TRUE;
}
# Check that the wizard hasn't already created any components with this name for a
# different type of room description
if (! $flag && $self->analysisType ne 'verbose') {
OUTER: foreach my $componentObj ($self->verboseComponentObjList) {
if ($componentObj->name eq $name) {
$flag = TRUE;
last OUTER;
}
}
}
if (! $flag && $self->analysisType ne 'short') {
OUTER: foreach my $componentObj ($self->shortComponentObjList) {
if ($componentObj->name eq $name) {
$flag = TRUE;
last OUTER;
}
}
}
if (! $flag && $self->analysisType ne 'brief') {
OUTER: foreach my $componentObj ($self->briefComponentObjList) {
if ($componentObj->name eq $name) {
$flag = TRUE;
last OUTER;
}
}
}
if (! $flag) {
# The component $name is available
return $name;
}
} until ($count >= 9999);
# Escape an (extremely unlikely) infinite loop by just using the name $type
return $type;
}
sub updateContentComponent {
# Called by $self->saveChanges
#
# $self->markerList contains the content marker patterns, e.g. 'is here' and 'are here'. The
# markers should also be added to components of the 'verb_content' and 'brief_content', by
# default (would be confusing for the user, if they had to do it themselves using the
# 'edit' window)
#
# Expected arguments
# $componentObj - The GA::Obj::Component to process (can be of any type, but only the
# types 'verb_content' and 'brief_content' are modified)
#
# Return values
# 'undef' on improper arguments or if no modifications are needed
# 1 otherwise
my ($self, $componentObj, $check) = @_;
# Check for improper arguments
if (! defined $componentObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->updateContentComponent', @_);
}
# Do nothing if $componentObj is of the wrong type, or if the list of content marker
# patterns in $self->markerList has been emptied
if (
! $self->markerList
|| ($componentObj->type ne 'verb_content' && $componentObj->type ne 'brief_content')
) {
return undef;
}
# Use the marker patterns as patterns which mark the start of the component
$componentObj->ivPush('startPatternList', $self->markerList);
# Any line which doesn't contain one of these patterns marks the end of the component
$componentObj->ivPush('stopBeforeNoPatternList', $self->markerList);
return 1;
}
##################
# Accessors - set
##################
# Accessors - get
sub customPrimaryDirHash
{ my $self = shift; return %{$self->{customPrimaryDirHash}}; }
sub customPrimaryAbbrevHash
{ my $self = shift; return %{$self->{customPrimaryAbbrevHash}}; }
sub definiteList
{ my $self = shift; return @{$self->{definiteList}}; }
sub indefiniteList
{ my $self = shift; return @{$self->{indefiniteList}}; }
sub andList
{ my $self = shift; return @{$self->{andList}}; }
sub orList
{ my $self = shift; return @{$self->{orList}}; }
( run in 0.954 second using v1.01-cache-2.11-cpan-fe3c2283af0 )