Games-Axmud
view release on metacpan or search on metacpan
lib/Games/Axmud/Win/Map.pm view on Meta::CPAN
$msg .= "Dir: " . $exitObj->dir . "\n";
if ($exitObj->mapDir) {
$msg .= "Map dir: " . $exitObj->mapDir . "\n";
} else {
$msg .= "Map dir: unallocatable\n";
}
$msg .= "Parent room: #" . $roomObj->number . "\n";
if ($regionObj) {
$msg .= "Region: '" . $regionObj->name . "'\n";
} else {
$msg .= "Region: <none>\n";
}
$msg .= "X-pos: " . $roomObj->xPosBlocks . "\n";
$msg .= "Y-pos: " . $roomObj->yPosBlocks . "\n";
$msg .= "Level: " . $roomObj->zPosBlocks;
# Display info about the exit
return $self->showMsgDialogue(
'Find exit',
'info',
$msg,
'ok',
undef,
TRUE, # Preserve newline characters in $msg
);
}
sub resetRoomDataCallback {
# Called by $self->enableEditColumn
# Resets data in one or more rooms
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user
# declines to continue the operation or if they specify no rooms
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$choice, $choice2, $response,
@list, @comboList, @list2, @comboList2, @roomList,
%comboHash, %comboHash2,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetRoomDataCallback', @_);
}
# (No standard callback check)
# Prepare combobox lists
@list = (
'Room titles' => 'title',
'Verbose descriptions' => 'descrip',
'Room tags' => 'room_tag',
'Room guilds' => 'room_guild',
'Room flags' => 'room_flag',
'Room commands' => 'room_cmd',
'Unspecified room patterns' => 'unspecified',
'Exit/depature patterns' => 'exit_depart',
'Checked directions' => 'checked_dir',
'Axbasic scripts' => 'script',
'Character visits' => 'char_visit',
'Exclusive profiles' => 'exclusive',
'Analysed nouns/adjectives' => 'noun_adj',
'Search results' => 'search',
'Remote data (MSDP/MXP)' => 'remote',
'Source code path' => 'path',
'All of the above' => 'all_data',
);
do {
my ($descrip, $arg);
$descrip = shift @list;
$arg = shift @list;
push (@comboList, $descrip);
$comboHash{$descrip} = $arg;
} until (! @list);
if ($self->currentRegionmap) {
if ($self->mapObj->currentRoom) {
push (@list2, 'Current room', 'current');
}
if ($self->selectedRoom || $self->selectedRoomHash) {
push (@list2, 'Selected rooms', 'selected');
}
push (@list2, 'Rooms in this region', 'region');
}
push (@list2, 'Rooms in all regions', 'all_rooms');
do {
my ($descrip, $arg);
$descrip = shift @list2;
$arg = shift @list2;
push (@comboList2, $descrip);
$comboHash2{$descrip} = $arg;
lib/Games/Axmud/Win/Map.pm view on Meta::CPAN
# Tell the world model to reset the specified data in the specified rooms
if (
! $self->worldModelObj->resetRoomData(
TRUE, # Update automapper windows now
$choice,
@roomList,
)
) {
$self->showMsgDialogue(
'Reset room data',
'error',
'Operation failed (internal error)',
'ok',
);
} else {
$self->showMsgDialogue(
'Reset room data',
'info',
'Operation complete',
'ok',
);
}
return 1;
}
sub resetVisitsCallback {
# Called by $self->enableEditColumn
# Prompts the user to ask the character(s) and region(s) in which character visit counts
# should be reset
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user chooses
# 'cancel' in the 'dialogue' window or if no characters/regions are found
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$currentCharString, $allCharString, $unCharString, $thisRegionString, $allRegionString,
$charChoice, $regionChoice, $unCharFlag, $roomCount, $deleteCount,
@charNameList, @charStringList, @regionStringList, @charList, @regionList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetVisitsCallback', @_);
}
# (No standard callback check)
# Prepare a list of character strings for a combobox
foreach my $profObj ($self->session->ivValues('profHash')) {
if (
$profObj->category eq 'char'
&& (
! $self->session->currentChar
|| $self->session->currentChar ne $profObj
)
) {
push (@charNameList, $profObj->name);
}
}
if ($self->session->currentChar) {
$currentCharString = 'Current character (' . $self->session->currentChar->name . ')';
push (@charStringList, $currentCharString);
}
$allCharString = 'All character profiles';
$unCharString = 'All characters without profiles';
push (@charStringList, $allCharString, $unCharString, @charNameList);
# Prepare region strings for a second combobox
if ($self->currentRegionmap) {
$thisRegionString = 'Current region (' . $self->currentRegionmap->name . ')';
push (@regionStringList, $thisRegionString);
}
$allRegionString = 'All regions';
push (@regionStringList, $allRegionString);
# Prompt the user to specify which characters/regions to reset
($charChoice, $regionChoice) = $self->showDoubleComboDialogue(
'Reset character visits',
'Select character(s)',
'Select a region(s)',
\@charStringList,
\@regionStringList,
);
if (! defined $charChoice) {
return undef;
}
# Compile a list of specified character(s)
if (defined $currentCharString && $charChoice eq $currentCharString) {
# Use the current character
push (@charList, $self->session->currentChar->name);
} elsif ($charChoice eq $allCharString) {
# Use all character profiles - including the current character (if there is one), which
# isn't in @charNameList
push (@charList, @charNameList);
if ($self->session->currentChar) {
push (@charList, $self->session->currentChar->name);
}
} else {
# Use the specified character
push (@charList, $charChoice);
}
# Compile a list of specified region(s)
if (defined $thisRegionString && $regionChoice eq $thisRegionString) {
push (@regionList, $self->currentRegionmap);
} elsif ($regionChoice eq $allRegionString) {
push (@regionList, $self->worldModelObj->ivValues('regionmapHash'));
}
# Set a handy flag if we're dealing with non-profile characters
if ($charChoice eq $unCharString) {
$unCharFlag = TRUE;
}
lib/Games/Axmud/Win/Map.pm view on Meta::CPAN
'error',
'The Locator task\'s current room appears to be empty',
'ok',
);
return undef;
}
# From this list, remove any temporary objects which have already been added to the
# automapper room's list of child objects during the current visit to the room
OUTER: foreach my $tempObj (@tempList) {
foreach my $childNum ($roomObj->ivKeys('childHash')) {
if ($tempObj eq $self->worldModelObj->ivShow('modelHash', $childNum)) {
# Don't add it again
next OUTER;
}
}
# $tempObj hasn't been added to the model yet
push (@useList, $tempObj);
}
} else {
# The user should be prompted for a string to parse. Use the (single) selected room
$roomObj = $self->selectedRoom;
# Prompt the user to enter a string to parse
$string = $self->showEntryDialogue(
'Add contents',
'Enter a string to parse (e.g. \'two hairy orcs and an axe\')',
);
if (! defined $string) {
# User clicked 'cancel' or closed the window
return undef;
} else {
# Try to parse the string into a list of objects (parse multiples as separate
# objects)
@useList = $self->worldModelObj->parseObj($self->session, FALSE, $string);
}
}
# Don't prompt for an object, if there are none available
if (! @useList) {
return $self->showMsgDialogue(
'Add contents',
'error',
'There are no objects to add',
'ok',
);
}
# Prepare a list of strings to display in a combobox
foreach my $obj (@useList) {
my $line;
if ($obj->category eq 'portable' || $obj->category eq 'decoration') {
$line = $obj->name . ' [' . $obj->category . ' - ' . $obj->type . ']';
} else {
$line = $obj->name . ' [' . $obj->category . ']';
}
push (@comboList, $line);
$comboHash{$line} = $obj;
}
# If there is more than one object that could be added, create something at the top of the
# combobox that lets the user add them all
if (@comboList > 1) {
$allString = '<add all ' . scalar @comboList . ' objects>';
unshift (@comboList, $allString);
}
# Prompt the user to select an object
$choice = $self->showComboDialogue(
'Select object',
'Choose which object(s) to add to the world model',
\@comboList,
);
if ($choice) {
if ($allString && $choice eq $allString) {
# Add all the objects to the model (use @useList, in case @comboList contained
# repeating strings, because there's more than one orc, for example, in the room)
@addList = @useList;
} else {
# Add a single object to the model
push (@addList, $comboHash{$choice});
}
# Add the objects to the world model as children of $roomObj
$self->worldModelObj->addRoomChildren(
TRUE, # Update Automapper windows
FALSE, # Children are not hidden
$roomObj,
undef, # Children are not hidden
@addList,
);
}
return 1;
}
sub addHiddenObjCallback {
# Called by $self->enableRoomsColumn
# Adds a non-model object from the Locator's current room to the world model, making it a
# child (and therefore contained in) the current room
# Alternatively, prompts the user to add a string like 'two hairy orcs and an axe'. Parses
# the string into a list of objects, and prompts the user to choose an object from that
# list
#
# Expected arguments
# $parseFlag - Set to TRUE if the user should be prompted for a sentence to parse. Set to
# FALSE if the list of objects should be taken from the Locator task
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the hidden
# object isn't added
# 1 otherwise
my ($self, $parseFlag, $check) = @_;
lib/Games/Axmud/Win/Map.pm view on Meta::CPAN
'ok',
);
return undef;
}
# Use the automapper's current room
$roomObj = $self->mapObj->currentRoom;
# Import the list of temporary non-model objects from the Locator's current room
@tempList = $taskObj->roomObj->tempObjList;
if (! @tempList) {
$self->showMsgDialogue(
'Add hidden object',
'error',
'The Locator task\'s current room appears to be empty',
'ok',
);
return undef;
}
# From this list, remove any temporary objects which have already been added to the
# automapper room's list of child objects during the current visit to the room
OUTER: foreach my $tempObj (@tempList) {
foreach my $childNum ($roomObj->ivKeys('childHash')) {
if ($tempObj eq $self->worldModelObj->ivShow('modelHash', $childNum)) {
# Don't add it again
next OUTER;
}
}
# $tempObj hasn't been added to the model yet
push (@useList, $tempObj);
}
} else {
# The user should be prompted for a string to parse. Use the (single) selected room
$roomObj = $self->selectedRoom;
# Prompt the user to enter a string to parse
$string = $self->showEntryDialogue(
'Add hidden object',
'Enter a string to parse (e.g. \'two hairy orcs and an axe\')',
);
if (! defined $string) {
# User clicked 'cancel' or closed the window
return undef;
} else {
# Try to parse the string into a list of objects. The TRUE argument tells the
# function to treat 'two hairy orcs' as a single object, with its
# ->multiple IV set to 2, so that the same strings don't appear in the combobox
# more than once (hopefully)
@useList = $self->worldModelObj->parseObj($self->session, TRUE, $string);
}
}
# Don't prompt for an object, if there are none available
if (! @useList) {
return $self->showMsgDialogue(
'Add hidden object',
'error',
'There are no objects to add',
'ok',
);
}
# Prepare a list of strings to display in a combobox
foreach my $obj (@useList) {
my $line;
if ($obj->category eq 'portable' || $obj->category eq 'decoration') {
$line = $obj->name . ' [' . $obj->category . ' - ' . $obj->type . ']';
} else {
$line = $obj->name . ' [' . $obj->category . ']';
}
push (@comboList, $line);
$comboHash{$line} = $obj;
}
($obtainCmd, $choice) = $self->showEntryComboDialogue(
'Select object',
'Enter the command used to obtain the hidden object',
'Choose which hidden object to add to the model',
\@comboList,
);
if ($choice) {
# Add the object to the world model as a (hidden) child of $roomObj
$self->worldModelObj->addRoomChildren(
TRUE, # Update Automapper windows
TRUE, # Mark child as hidden
$roomObj,
$obtainCmd,
$comboHash{$choice}, # The non-model object to add to the world model
);
}
return 1;
}
sub addSearchResultCallback {
# Called by $self->enableRoomsColumn
# Adds the results of a 'search' command at the current location (stored in the
# room object's ->searchHash IV)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($term, $result);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addSearchResultCallback',
@_,
lib/Games/Axmud/Win/Map.pm view on Meta::CPAN
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| (
$self->selectedExit->drawMode ne 'temp_alloc'
&& $self->selectedExit->drawMode ne 'temp_unalloc'
)
) {
return undef;
}
# In a few rare circumstances, $self->selectedExit seems to get reset before the world model
# can be updated. Store it in a local variable to prevent this
$exitObj = $self->selectedExit;
# Prepare a list of standard primary directions. Whether we include 'northnortheast', etc,
# depends on the current value of $self->worldModelObj->showAllPrimaryFlag
@shortList = qw(north northeast east southeast south southwest west northwest up down);
# (For convenience, put the longest directions at the end)
@longList = qw(
northnortheast eastnortheast eastsoutheast southsoutheast
southsouthwest westsouthwest westnorthwest northnorthwest
);
if ($self->worldModelObj->showAllPrimaryFlag) {
@dirList = (@shortList, @longList);
} else {
@dirList = @shortList;
}
# Get the blessed reference of the selected exit's parent room
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
# Prepare a list of primary direction exits which are still available
@comboList = $self->getAvailableDirs($roomObj, @dirList);
# (The exit's current allocated direction, if it was in @dirList, will be the first item in
# the list)
$firstComboItem = shift @comboList;
# (Work out how many available exits were returned)
$number = scalar @comboList;
if (defined $firstComboItem) {
$number++;
}
if ($number <= 2 && ! $self->worldModelObj->showAllPrimaryFlag) {
# We didn't show 'northnortheast' the first time, but there are not many primary
# directions from which the user can choose; in fact, @comboList probably consists of
# just 'up' and 'down' (which is why we test @comboList <= 2)
# Add 'northnortheast', so the user has more choices
@extraList = $self->getAvailableDirs($roomObj, @longList);
$extraComboItem = shift @extraList;
push (@comboList, @extraList);
}
# The exit's current allocated direction, if available, should be the first item in the
# combobox
if ($firstComboItem) {
unshift(@comboList, $firstComboItem);
} elsif ($extraComboItem) {
unshift(@comboList, $extraComboItem);
}
# Don't prompt for a direction, if there are none available
if (! @comboList) {
return $self->showMsgDialogue(
'Select map direction',
'error',
'Can\'t allocate a map direction - no primary directions are available',
'ok',
);
}
# Prompt the user for a primary direction
$choice = $self->showComboDialogue(
'Select map direction',
'Choose a primary direction for the \'' . $exitObj->dir . '\' exit',
\@comboList,
);
if (! $choice) {
return undef;
} else {
# Update the selected exit and instruct the world model to update its Automapper windows
$self->worldModelObj->setExitMapDir(
$self->session,
TRUE, # Update Automapper windows now
$roomObj,
$exitObj,
$choice,
);
return 1;
}
}
sub confirmTwoWayCallback {
# Called by $self->enableExitsColumn
# For an unallocated exit, attempts to allocate it a map (primary) direction that's the
# opposite of an incoming uncertain or 1-way exit, and to connect them as twin exits
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# clicks 'cancel' in the 'dialogue' window
# 1 otherwise
my ($self, $check) = @_;
# Local variables
lib/Games/Axmud/Win/Map.pm view on Meta::CPAN
);
# The specified style is the preferred one
if (defined $style) {
$self->worldModelObj->set_mapLabelStyle($style);
}
return 1;
} else {
return undef;
}
}
sub setLabelDirectCallback {
# Called by $self->enableLabelsPopupMenu (only)
#
# Sets the selected label's label style, without needing to prompt the user any further
#
# Expected arguments
# $style - The name of the label style to use
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $style, $check) = @_;
# Check for improper arguments
if (! defined $style || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setLabelDirectCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedLabel) {
return undef;
}
$self->worldModelObj->updateLabel(
TRUE, # Update automapper windows now
$self->session,
$self->selectedLabel,
$self->selectedLabel->name, # The label text remains unchanged
$style,
);
# The specified style is the preferred one
$self->worldModelObj->set_mapLabelStyle($style);
return 1;
}
sub selectLabelCallback {
# Called by $self->enableLabelsColumn
# Prompts the user to select a label, from a combobox listing all the labels in the current
# regionmap
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$allString, $choice, $labelObj,
@labelList, @sortedList, @comboList, @finalList,
%comboHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectLabelCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Get a sorted list of labels
@labelList = $self->currentRegionmap->ivValues('gridLabelHash');
@sortedList = sort {lc($a->name) cmp lc($b->name)} (@labelList);
# Don't prompt for a label, if there are none available
if (! @sortedList) {
return $self->showMsgDialogue(
'Select label',
'error',
'There are no labels in this region',
'ok',
);
}
# Prepare the contents of a combobox. Those labels which aren't on the currently displayed
# level are marked as being on a different level
foreach my $obj (@sortedList) {
my $string;
if ($obj->level == $self->currentRegionmap->currentLevel) {
$string = $obj->name;
} else {
$string = $obj->name . ' (level ' . $obj->level . ')';
}
push (@comboList, $string);
$comboHash{$string} = $obj;
}
# At the top of the list, put an option to select all labels
$allString = '<select all labels>';
unshift (@comboList, $allString);
# Prompt the user for a label
$choice = $self->showComboDialogue(
'Select label',
'Choose a label to mark as selected',
\@comboList,
);
if ($choice) {
if ($choice eq $allString) {
# Unselect any existing selected objects
$self->setSelectedObj();
# Select every label in this region
foreach my $obj (@sortedList) {
push (@finalList, $obj, 'label');
}
# Select the labels
$self->setSelectedObj(
\@finalList,
TRUE, # Select multiple objects
);
} else {
$labelObj = $comboHash{$choice};
# Select the label
$self->setSelectedObj(
[$labelObj, 'label'],
FALSE, # Select this object; unselect all other objects
);
}
}
lib/Games/Axmud/Win/Map.pm view on Meta::CPAN
if ($self->selectedExitTagHash) {
push (@returnList, $self->ivValues('selectedExitTagHash'));
}
return @returnList;
}
sub compileSelectedLabels {
# Called by several menu/callback functions
# Returns a list of selected labels, combining the contents of $self->selectedLabel and
# ->selectedLabelHash
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments, if there is no current regionmap or if
# $self->selectedLabel and ->selectedLabelHash are both empty
# Otherwise, returns a list containing blessed references to the GA::Obj::MapLabel
# objects stored in $self->selectedLabel or $self->selectedLabelHash
my ($self, $check) = @_;
# Local variables
my (@emptyList, @returnList);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->compileSelectedLabels', @_);
return @emptyList;
}
# No selected labels if there's no regionmap
if (! $self->currentRegionmap) {
return @emptyList;
}
# Compile selected labels
if ($self->selectedLabel) {
push (@returnList, $self->selectedLabel);
}
if ($self->selectedLabelHash) {
push (@returnList, $self->ivValues('selectedLabelHash'));
}
return @returnList;
}
sub compileExitList {
# Called by several functions
# Returns a list containing the selected exit, its twin exit (if it has one), and any exits
# for which those two are the shadow exits
# Also returns a hash, ready for display in a combobox, so that the user can select the
# exit(s) on which to perform an operation
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments
# Otherwise the list containing two elements, a reference to @stringList and a reference
# to %exitHash
# %exitHash is in the form
# $exitHash{long_string_describing_exit} = blessed_ref_of_exit_object
# @stringList contains a list of keys in %exitHash, in the order in which they were added
my ($self, $check) = @_;
# Local variables
my (
$twinExitObj,
@exitList, @stringList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->compileExitList', @_);
}
# Compile a list of exits. Start with the selected exit, and its twin exit
# (if there is one)
push (@exitList, $self->selectedExit);
if ($self->selectedExit->twinExit) {
$twinExitObj
= $self->worldModelObj->ivShow('exitModelHash', $self->selectedExit->twinExit);
if ($twinExitObj) {
push (@exitList, $twinExitObj);
}
}
# Add entries to a hash that we use to populate a combobox
foreach my $exitObj (@exitList) {
my $string = '#' . $exitObj->number . ' ' . $exitObj->dir . ' (room #'
. $exitObj->parent . ')';
push (@stringList, $string);
$exitHash{$string} = $exitObj;
}
# Check the parent room(s) of the exit (and its twin exit, if there is one)
# If either of these rooms have exits whose shadow exits are already on @objList, add those
# exits, too
foreach my $exitObj (@exitList) {
my $parentRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
foreach my $otherExitNumber ($parentRoomObj->ivValues('exitNumHash')) {
my $otherExitObj = $self->worldModelObj->ivShow('exitModelHash', $otherExitNumber);
if (
$otherExitObj ne $exitObj
&& $otherExitObj->shadowExit
&& $otherExitObj->shadowExit eq $exitObj->number
) {
my $string = '#' . $otherExitObj->number . ' ' . $otherExitObj->dir
. ' (~' . $exitObj->number . ', room #' . $parentRoomObj->number . ')';
push (@stringList, $string);
$exitHash{$string} = $otherExitObj;
}
}
}
return (\@stringList, \%exitHash);
}
sub checkCredibleExit {
# Called by $self->findClickedExit and $self->findOverlayingExit to check whether a mouse
# click is credibly near an exit (and not miles and miles away)
# If successful, the calling function can go to the trouble of making more precise checks
#
# Expected arguments
# $clickXPosPixels, $clickYPosPixels
# - The coordinates of the clicked pixel
# $startXPosPixels, $startYPosPixels,
# - The coordinates of one end of the exit
# $stopXPosPixels, $stopYPosPixels
# - The coordinates of the other end of the exit
#
# Return values
# 'undef' on improper arguments or if the mouse click is not credibly near an exit
# 1 if the mouse click is credibly near an exit
my (
$self, $clickXPosPixels, $clickYPosPixels, $startXPosPixels, $startYPosPixels,
$stopXPosPixels, $stopYPosPixels, $check
) = @_;
lib/Games/Axmud/Win/Map.pm view on Meta::CPAN
&& $thisExitObj->mapDir eq $dir
&& $thisExitObj->drawMode ne 'temp_alloc'
&& $thisExitObj->drawMode ne 'temp_unalloc'
) {
# $dir isn't available
next OUTER;
}
}
# $dir is available
push (@availableList, $dir);
}
}
# Get a sorted list of all non-world profiles...
foreach my $profObj ($self->session->ivValues('profHash')) {
if ($profObj->category ne 'world') {
push (@profList, $profObj->name);
}
}
@profList = sort {lc($a) cmp lc($b)} (@profList);
# ...and put the current world profile at the top of the list
unshift (@profList, $self->session->currentWorld->name);
# That completes the setup. Now, show the 'dialogue' window
my $dialogueWin = Gtk3::Dialog->new(
$title,
$self->winWidget,
Gtk3::DialogFlags->new([qw/modal destroy-with-parent/]),
'gtk-cancel' => 'reject',
'gtk-ok' => 'accept',
);
$dialogueWin->set_position('center-always');
$dialogueWin->set_icon_list($axmud::CLIENT->desktopObj->{dialogueWinIconList});
$dialogueWin->signal_connect('delete-event' => sub {
$dialogueWin->destroy();
$self->restoreFocus();
return @emptyList;
});
# Add widgets to the 'dialogue' window
my $vBox = $dialogueWin->get_content_area();
# The call to ->addDialogueIcon splits $vBox in two, with an icon on the left, and a new
# Gtk3::VBox on the right, into which we put everything
my $vBox2 = $self->addDialogueIcon($vBox);
# Add widgets
my ($entry, $entry2, $entry3, $entry4, $comboBox, $comboBox2);
# Called by $self->addExitCallback or ->changeDirCallback
if (! $exitObj || ($exitObj && $mode eq 'change_dir')) {
# Work out which map directon should be displayed in the first combobox (corresponds
# to GA::Obj::Exit->mapDir, if defiend)
if ($exitObj && $exitObj->mapDir && $mode eq 'change_dir') {
# Use the existing exit's map direction, ->mapDir (if defined). Does this direction
# already exist in @availableList?
if (@availableList) {
OUTER: for (my $count = 0; $count < @availableList; $count++) {
if ($availableList[$count] eq $exitObj->mapDir) {
$match = $count;
last OUTER;
}
}
}
if (! defined $match) {
# The existing map direction is missing from the list; add it to
# the beginning
unshift(@availableList, $exitObj->mapDir);
$match = 0;
}
} else {
# Use the first map direction in the list initially
$match = 0;
}
# Add a combobox to choose the map direction
my $label = Gtk3::Label->new();
$vBox2->pack_start($label, FALSE, FALSE, 5);
$label->set_alignment(0, 0);
$label->set_markup('Standard map direction, e.g. <i>\'north\' </i>');
$comboBox = Gtk3::ComboBoxText->new();
$vBox2->pack_start($comboBox, FALSE, FALSE, 5);
foreach my $dir (@availableList) {
$comboBox->append_text($dir);
}
$comboBox->set_active($match);
# Add an entry box to choose the exit's nominal direction, if different
my $label2 = Gtk3::Label->new();
$vBox2->pack_start($label2, FALSE, FALSE, 5);
$label2->set_alignment(0, 0);
$label2->set_markup('Matches named exit, e.g. <i>\'north\', \'portal\' </i>');
$entry = Gtk3::Entry->new();
$vBox2->pack_start($entry, FALSE, FALSE, 5);
if ($exitObj && $mode eq 'change_dir') {
# The entry should contain the existing exit object's nominal direction
$entry->set_text($exitObj->dir);
} else {
# The entry should contain the same direction selected in the combobox, unless the
# user manually types a different value
if (@availableList) {
$entry->set_text(
$self->session->currentDict->ivShow(
'primaryDirHash',
$availableList[0],
),
);
}
}
# When the user selects a new direction in the combobox, automatically update the entry
# (unless it's a call from ->changeDirCallback, in which case we only update the entry
# if it originally matched the map direction - this prevents the unfortunate situation
# of an exit whose ->mapDir is 'north' and whose ->dir is 'in' from having both set to
# 'northwest', when the user only meant to change the map direction
if ($exitObj && $mode eq 'change_dir') {
# (This function called by ->changeDirCallback)
$comboBox->signal_connect('changed' => sub {
my ($text, $customDir);
$text = $comboBox->get_active_text();
if ($exitObj->mapDir) {
$customDir = $self->session->currentDict->ivShow(
'primaryDirHash',
$exitObj->mapDir,
);
if ($customDir eq $exitObj->dir) {
$entry->set_text($comboBox->get_active_text());
}
}
});
} else {
# (This function not called by ->changeDirCallback)
$comboBox->signal_connect('changed' => sub {
my $text = $comboBox->get_active_text();
$entry->set_text($self->session->currentDict->ivShow('primaryDirHash', $text));
});
}
my $line = Gtk3::HSeparator->new();
$vBox2->pack_start($line, FALSE, FALSE, 5);
}
# Called by ->setAssistedMoveCallback
if ($exitObj && $mode eq 'set_assist') {
# Add two entry boxes, which can't be modified, to inform the user which exit they're
# modifying. The format is the same as for the add exit 'dialogue' window
my $label = Gtk3::Label->new();
$vBox2->pack_start($label, FALSE, FALSE, 5);
$label->set_alignment(0, 0);
$label->set_markup('Direction drawn on map, e.g. <i>\'north\' </i>');
$entry3 = Gtk3::Entry->new();
$vBox2->pack_start($entry3, FALSE, FALSE, 5);
if ($exitObj->mapDir) {
$entry3->set_text($exitObj->mapDir);
} else {
$entry3->set_text('unallocatable');
}
$entry3->set_sensitive(FALSE);
my $label2 = Gtk3::Label->new();
$vBox2->pack_start($label2, FALSE, FALSE, 5);
$label2->set_alignment(0, 0);
$label2->set_markup('Matches named exit, e.g. <i>\'north\', \'portal\' </i>');
$entry4 = Gtk3::Entry->new();
$vBox2->pack_start($entry4, FALSE, FALSE, 5);
$entry4->set_text($exitObj->dir);
$entry4->set_sensitive(FALSE);
}
# Called by $self->addExitCallback or ->setAssistedMoveCallback
if (! $exitObj || ($exitObj && $mode eq 'set_assist')) {
# Add a combobox and an entry to add an optional key-value pair to ->assistedMoveHash
my $label4 = Gtk3::Label->new();
$vBox2->pack_start($label4, FALSE, FALSE, 5);
$label4->set_alignment(0, 0);
if (! $exitObj) {
$label4->set_markup('Optional: Assisted move for the profile');
} else {
$label4->set_markup('Assisted move for the profile');
}
$comboBox2 = Gtk3::ComboBoxText->new();
$vBox2->pack_start($comboBox2, FALSE, FALSE, 5);
foreach my $profile (@profList) {
$comboBox2->append_text($profile);
}
$comboBox2->set_active(0);
my $label5 = Gtk3::Label->new();
$vBox2->pack_start($label5, FALSE, FALSE, 5);
$label5->set_alignment(0, 0);
$label5->set_markup(
'Command sequence, e.g. <i>\'push button' . $axmud::CLIENT->cmdSep . 'north\' </i>',
);
$entry2 = Gtk3::Entry->new();
$vBox2->pack_start($entry2, FALSE, FALSE, 5);
# When called by ->setAssistedMoveCallback, the entry box should contain the assisted
# move for the profile displayed in $comboBox2, if any
if ($exitObj) {
$assistedProf = $comboBox2->get_active_text();
if ($assistedProf && $exitObj->ivExists('assistedHash', $assistedProf)) {
$entry2->set_text($exitObj->ivShow('assistedHash', $assistedProf));
}
}
# When the user changes the profile in $comboBox2, the assisted move displayed in
# $entry2 should be updated
$comboBox2->signal_connect('changed' => sub {
$assistedProf = $comboBox2->get_active_text();
if (
$assistedProf
&& $exitObj
&& $exitObj->ivExists('assistedHash', $assistedProf)
) {
$entry2->set_text($exitObj->ivShow('assistedHash', $assistedProf));
} else {
# Clear the previously displayed text, if any
$entry2->set_text('');
}
});
}
( run in 1.907 second using v1.01-cache-2.11-cpan-8dfa8b56332 )