# Copyright (C) 2011-2024 A S Lewis
#
# This program is free software: you can redistribute it and/or modify it under the terms of the GNU
# General Public License as published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with this program. If not,
# see <http://www.gnu.org/licenses/>.
#
#
# Games::Axmud::Win::Map
# The Automapper window object (separate and independent from the automapper object, GA::Obj::Map)
{ package Games::Axmud::Win::Map;
use strict;
use warnings;
# use diagnostics;
use Glib qw(TRUE FALSE);
our @ISA = qw(
Games::Axmud::Generic::MapWin Games::Axmud::Generic::GridWin Games::Axmud::Generic::Win
Games::Axmud
);
##################
# Constructors
sub new {
# Called by GA::Obj::Workspace->createGridWin and ->createSimpleGridWin
# Creates an Automapper window
#
# Expected arguments
# $number - Unique number for this window object
# $winType - The window type, must be 'map'
# $winName - The window name, must be 'map'
# $workspaceObj
# - The GA::Obj::Workspace object for the workspace in which this window is
# created
#
# Optional arguments
# $owner - The owner, if known ('undef' if not). Typically it's a GA::Session or a
# task (inheriting from GA::Generic::Task); could also be GA::Client. It
# should not be another window object (inheriting from GA::Generic::Win).
# The owner should have its own ->del_winObj function which is called when
# $self->winDestroy is called
# $session - The owner's session. If $owner is a GA::Session, that session. If it's
# something else (like a task), the task's session. If $owner is 'undef',
# so is $session
# $workspaceGridObj
# - The GA::Obj::WorkspaceGrid object into whose grid this window has been
# placed. 'undef' in $workspaceObj->gridEnableFlag = FALSE
# $areaObj - The GA::Obj::Area (a region of a workspace grid zone) which handles this
# window. 'undef' in $workspaceObj->gridEnableFlag = FALSE
# $winmap - Ignored if set
#
# Return values
# 'undef' on improper arguments or if no $session was specified
# Blessed reference to the newly-created object on success
my (
$class, $number, $winType, $winName, $workspaceObj, $owner, $session, $workspaceGridObj,
$areaObj, $winmap, $check,
) = @_;
# Check for improper arguments
if (
! defined $class || ! defined $number || ! defined $winType || ! defined $winName
|| ! defined $workspaceObj || defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
# Automapper windows are unique to their session. If no $session is specified, refuse to
# create a window object
if (! $session) {
return undef;
}
# Check that the $winType is valid
if ($winType ne 'map') {
return $axmud::CLIENT->writeError(
'Internal window error: invalid \'map\' window type \'' . $winType . '\'',
$class . '->new',
);
}
# Setup
my $self = {
_objName => 'map_win_' . $number,
_objClass => $class,
_parentFile => undef, # No parent file object
_parentWorld => undef, # No parent file object
_privFlag => TRUE, # All IVs are private
# Standard window object IVs
# --------------------------
# Unique number for this window object
number => $number,
# The window category - 'grid' or 'free'
winCategory => 'grid',
# The window type, must be 'map'
winType => $winType,
# The window name, must be 'map'
winName => $winName,
# The GA::Obj::Workspace object for the workspace in which this window is created
workspaceObj => $workspaceObj,
# The owner, if known ('undef' if not). Typically it's a GA::Session or a task
# (inheriting from GA::Generic::Task); could also be GA::Client. It should not be
# another window object (inheriting from GA::Generic::Win). The owner must have its
# own ->del_winObj function which is called when $self->winDestroy is called
owner => $owner,
# The owner's session ('undef' if not). If ->owner is a GA::Session, that session. If
# it's something else (like a task), the task's sesssion. If ->owner is 'undef', so is
# ->session
session => $session,
# When GA::Session->pseudoCmd is called to execute a client command, the mode in which
# it should be called (usually 'win_error' or 'win_only', which causes errors to be
# displayed in a 'dialogue' window)
pseudoCmdMode => 'win_only',
# The window widget. For most window objects, the Gtk3::Window. For pseudo-windows, the
# parent 'main' window's Gtk3::Window
# The code should use this IV when it wants to do something to the window itself
# (minimise it, make it active, etc)
winWidget => undef,
# The window container. For most window objects, the Gtk3::Window. For pseudo-windows,
# the parent GA::Table::PseudoWin table object
# The code should use this IV when it wants to add, modify or remove widgets inside the
# window itself
winBox => undef,
# Flag set to TRUE if the window actually exists (after a call to $self->winEnable),
# FALSE if not
enabledFlag => FALSE,
# Flag set to TRUE if the Gtk3 window itself is visible (after a call to
# $self->setVisible), FALSE if it is not visible (after a call to $self->setInvisible)
visibleFlag => TRUE,
# Registry hash of 'free' windows (excluding 'dialogue' windows) for which this window
# is the parent, a subset of GA::Obj::Desktop->freeWinHash. Hash in the form
# $childFreeWinHash{unique_number} = blessed_reference_to_window_object
childFreeWinHash => {},
# When a child 'free' window (excluding 'dialogue' windows) is destroyed, this parent
# window is informed via a call to $self->del_childFreeWin
# When the child is destroyed, this window might want to call some of its own functions
# to update various widgets and/or IVs, in which case this window adds an entry to
# this hash; a hash in the form
# $childDestroyHash{unique_number} = list_reference
# ...where 'unique_number' is the child window's ->number, and 'list_reference' is a
# reference to a list in groups of 2, in the form
# (sub_name, argument_list_ref, sub_name, argument_list_ref...)
childDestroyHash => {},
# The container widget into which all other widgets are packed (usually a Gtk3::VBox or
# Gtk3::HBox, but any container widget can be used; takes up the whole window client
# area)
packingBox => undef,
# Standard IVs for 'grid' windows
# The GA::Obj::WorkspaceGrid object into whose grid this window has been placed. 'undef'
# if $workspaceObj->gridEnableFlag = FALSE
workspaceGridObj => $workspaceGridObj,
# The GA::Obj::Area object for this window. An area object is a part of a zone's
# internal grid, handling a single window (this one). Set to 'undef' in
# $workspaceObj->gridEnableFlag = FALSE
areaObj => $areaObj,
# For pseudo-windows (in which a window object is created, but its widgets are drawn
# inside a GA::Table::PseudoWin table object), the table object created. 'undef' if
# this window object is a real 'grid' window
pseudoWinTableObj => undef,
# The ->name of the GA::Obj::Winmap object (not used for 'map' windows)
winmap => undef,
# IVs for this kind of 'map' window
# The parent automapper object (a GA::Obj::Map - set later)
mapObj => undef,
# The session's current world model object
worldModelObj => $session->worldModelObj,
# The menu bar
menuBar => undef,
# The window can have several toolbars. Toolbars each have a button set, and there are
# several button sets to choose from
# If the window component for toolbars is turned on, there is at least one toolbar,
# which has a switcher button and an adder button, followed by the default button set.
# The switcher button switches between button sets, and the adder button adds a new
# toolbar below the existing ones
# Additional toolbars have a remove button, which removes that toolbar
# Each button set can only be visible once; the switcher button switches to the next
# button set that isn't already in use
# GA::Obj::WorldModel->buttonSetList stores which button sets should be used when the
# automapper window opens, and is updated as the user adds/removes sets (but not when
# the user clicks the switcher button; when the window opens, the first button set is
# always the default one)
#
# Constant list of names of button sets, in the order used by the switcher button
constButtonSetList => [
'default', # The default set, visible when the window first opens
'exits',
'painting',
'quick',
'background',
'tracking',
'misc',
'flags',
'interiors',
],
# Constant hash of names of button sets and their corresponding (short) descriptions
constButtonDescripHash => {
'default' => 'Show the default button set', # Never actually used
'exits' => 'Show exit customisation buttons',
'painting' => 'Show room painting buttons',
'quick' => 'Show quick painting buttons',
'background' => 'Show background colouring buttons',
'tracking' => 'Show room tracking buttons',
'misc' => 'Show miscellaneous buttons',
'flags' => 'Show room flag filter buttons',
'interiors' => 'Show room interior buttons',
},
# Hash of names of button sets, showing which are visible (TRUE) and which are not
# visible (FALSE)
buttonSetHash => {
'default' => FALSE,
'exits' => FALSE,
'painting' => FALSE,
'quick' => FALSE,
'background' => FALSE,
'tracking' => FALSE,
'misc' => FALSE,
'flags' => FALSE,
'interiors' => FALSE,
},
# Ordered list of toolbar widgets that are visible now, with the default toolbar always
# first in the list
toolbarList => [],
# Corresponding hash of toolbar widgets, in the form
# $toolbarHash{toolbar_widget} = name_of_button_set_visible_now
toolbarHash => {},
# A list of button widgets in the original toolbar (not including the add button, the
# switcher button and the separator that follows them); updated every time the user
# clicks the switcher icon
# NB Buttons in additional toolbars aren't stored in an IV
toolbarButtonList => [],
# The 'add' button in the original toolbar
toolbarAddButton => undef,
# The 'switch' button in the original toolbar
toolbarSwitchButton => undef,
# The default set (the first one drawn); this IV never changes
constToolbarDefaultSet => 'default',
# Whenever the original (first) toolbar is drawn, this IV records the button set used
# (so that the same button set appears whenever $self->redrawWidgets is called)
toolbarOriginalSet => 'default',
# Hash of room flags currently in use as preferred room flags, and whose toolbar button
# in the 'painter' set (if visible) is currently toggled on. The hash is reset every
# time the toolbar is drawn or redrawn, and is used to make sure that the toggled
# button(s) remain toggled after the redraw
# Hash in the form
# toolbarRoomFlagHash{room_flag} = undef
toolbarRoomFlagHash => {},
# When a colour button in the quick painting button set it toggled, the corresponding
# room flag is stored here
# When this IV is defined, clicking a room toggles the room flag in that room. If
# multiple rooms are selected, and one of the selected rooms was the clicked one,
# the room flag is toggled in all of them
toolbarQuickPaintColour => undef,
# Menu bar/toolbar items which will be sensitised or desensitised, depending on the
# context. Hash in the form
# $menuToolItemHash{'item_name'} = Gtk3_widget
# ...where:
# 'item_name' is a descriptive scalar, e.g. 'move_up_level'
# 'Gtk3_widget' is the Gtk3::MenuItem or toolbar widget, typically Gtk3::ToolButton or
# Gtk3::RadioToolButton
# NB Entries in this hash continue to exist, after the widgets are no longer visible.
# Doesn't matter, because there are a limited number of 'item_name' scalars, and so
# a limited size to the hash (and referencing no-longer visible widgets, for example
# to sensitise/desensitise them, doesn't have any ill effects)
menuToolItemHash => {},
# A horizontal pane, dividing the treeview on the left from everything else on the right
hPaned => undef,
# The treeview widgets (on the left)
treeViewModel => undef,
treeView => undef,
treeViewScroller => undef,
treeViewWidthPixels => 150, # (Default width)
# The currently selected line of the treeview (selected by single-clicking on it)
treeViewSelectedLine => undef,
# A hash of regions in the treeview, which stores which rows containing parent regions
# have been expanded to reveal their child regions
# Hash in the form
# $treeViewRegionHash{region_name} = flag
# ...where 'flag' is TRUE when the row is expanded, FALSE when the row is not expanded
treeViewRegionHash => {},
# A hash of pointers (iters) in the treeview, so we can look up each region's cell
treeViewPointerHash => {},
# Canvas widgets (on the right)
# ->canvas and ->canvasBackground store widgets for the current region and level (or the
# empty background map, if no region/level are visible)
canvas => undef,
canvasBackground => undef,
canvasFrame => undef,
canvasScroller => undef,
canvasHAdjustment => undef,
canvasVAdjustment => undef,
# The size of the available area inside the scrolled window, set whenever the
# scrolled window's size-allocate signal is emitted (this is the only way to guarantee
# that the correct size is available to $self->setMapPosn)
canvasScrollerWidth => 1,
canvasScrollerHeight => 1,
# Blessed reference of the currently displayed GA::Obj::Regionmap ('undef' if no region
# is displayed; not necessarily the same region as the character's current location)
currentRegionmap => undef,
# Blessed reference of the currently displayed GA::Obj::Parchment ('undef' if no region
# is displayed; not necessarily the same region as the character's current location)
currentParchment => undef,
# List of the names of regions that have been the current region recently. Does not
# include the current region, nor any duplicates, nor more than three regions. The
# most recent current region is the first one in the list. The list is modified
# whenever $self->setCurrentRegion is called
recentRegionList => [],
# Flag set to TRUE if the visible map is the empty background map (created by a call to
# $self->resetMap). Set to FALSE if the visible map is a region (created by a call to
# $self->refreshMap). Set to FALSE if neither ->resetMap nor ->refreshMap have been
# called yet
emptyMapFlag => FALSE,
# The first call to $self->winUpdate calls $self->preparePreDraw to compile a list of
# regions which should be drawn by background processes (i.e. regular calls to
# $self->winUpdate). It then sets this flag to TRUE so it knows no further calls to
# $self->preparePreDraw are necessary
winUpdateCalledFlag => FALSE,
# If a call to $self->doDraw fails because a drawing cycle (i.e. another call to
# ->doDraw) is already in progress, then this flag is set to TRUE. When set to TRUE,
# $self->winUpdate knows that it must make another call to ->doDraw
winUpdateForceFlag => FALSE,
# When $self->doDraw fails on a call from $self->setCurrentRegion or ->redrawRegions,
# this flag is also set to TRUE, as additional action is required. It remains set to
# FALSE when calls to ->doDraw fail for any other reason
winUpdateShowFlag => FALSE,
# Hash of parchment objects (GA::Obj::Parchment), once for each region which has been
# drawn (or is being drawn)
# Hash in the form
# $parchmentHash{region_name} = blessed_reference_to_parchment_object
parchmentHash => {},
# Parchment objects can be in states - fully drawn, or partially drawn. Firstly, a hash
# of parchment objects which are fully drawn, in the form
# $parchmentReadyHash{region_name} = blessed_reference_to_parchment_object
parchmentReadyHash => {},
# Secondly, a list of parchment objects which are partially drawn, Background processes
# draw canvas objects in the first parchment object in the list, before moving it to
# ->parchmentReadyHash; then they start drawing the next parchment object in the list
# until the list is empty
parchmentQueueList => [],
# Tooltips
# The current canvas object for which a tooltip is displayed ('undef' if no canvas
# object has a tooltip displayed)
canvasTooltipObj => undef,
# What type of canvas object it is: 'room', 'room_tag', 'room_guild', 'exit', 'exit_tag'
# or 'label'
canvasTooltipObjType => undef,
# When tooltips are visible, a useless 'leave-notify' event occurs. When the mouse moves
# over a canvas object, ->canvasTooltipObj is set and this IV is set to TRUE; if the
# next event is a 'leave-notify' event, it is ignored
canvasTooltipFlag => FALSE,
# Objects on the map can be selected. There are three modes of selection:
# (1) There is a single room, OR a single room tag, OR a single room guild, OR a
# single exit, OR a single exit tag, OR a single label selected
# (2) Multiple objects are selected (including combinations of rooms, room tags, room
# guilds, exits, exit tags and labels)
# (3) Nothing is currently selected
# In mode (1), one (or none) of the IVs ->selectedRoom, ->selectedRoomTag,
# ->selectedRoomGuild, ->selectedExit, ->selectedExitTag or ->selectedLabel is set
# (but the mode 2 IVs are empty)
# In mode (2), the selected objects are in ->selectedRoomHash, ->selectedRoomTagHash,
# ->selectedRoomGuildHash ->selectedExitHash, ->selectedExitTagHash and
# ->selectedLabelHash (but the mode 1 IVs are set to 'undef')
# In mode (3), all of the IVs below are not set
#
# Mode (1) IVs
# Blessed reference of the currently selected location (a GA::ModelObj::Room), which
# might be the same as $self->mapObj->currentRoom or $self->mapObj->lastKnownRoom
selectedRoom => undef,
# Blessed reference of the location (a GA::ModelObj::Room) whose room tag is selected
selectedRoomTag => undef,
# Blessed reference of the location (a GA::ModelObj::Room) whose room guild is selected
selectedRoomGuild => undef,
# Blessed reference of the currently selected exit (a GA::Obj::Exit)
selectedExit => undef,
# Blessed reference of the exit (a GA::Obj::Exit) whose exit tag is selected
selectedExitTag => undef,
# Blessed reference of the currently selected label (a GA::Obj::MapLabel object)
selectedLabel => undef,
# Mode (2) IVs
# Hash of selected locations, in the form
# $selectedRoomHash{model_number} = blessed_reference_to_room_object
selectedRoomHash => {},
# Hash of locations whose room tags are selected, in the form
# $selectedRoomTagHash{model_number) = blessed_reference_to_room_object
selectedRoomTagHash => {},
# Hash of locations whose room guilds are selected, in the form
# $selectedRoomGuildHash{model_number) = blessed_reference_to_room_object
selectedRoomGuildHash => {},
# Hash of selected exits, in the form
# $selectedExitHash{exit_model_number} = blessed_reference_to_exit_object
selectedExitHash => {},
# Hash of exits whose exit tags are selected, in the form
# $selectedExitTagHash{exit_model_number} = blessed_reference_to_exit_object
selectedExitTagHash => {},
# Hash of selected labels, in the form
# $selectedLabelHash{label_id) = blessed_reference_to_map_label_object
# ...where 'label_id' is in the form 'region-name_label_number', e.g. 'town_42'
selectedLabelHash => {},
# When there is a single selected exit ($self->selectedExit is set), and if it's a
# broken or a region exit, the twin exit (and its parent room) are drawn a different
# colour
# When the broken/region exit is selected, these IVs are set...
# The blessed reference of the twin exit
pairedTwinExit => undef,
# The blessed reference of the twin exit's parent room
pairedTwinRoom => undef,
# Flag that can be set to TRUE by any code that wants to prevent a drawing operation
# from starting (temporarily); the operation will be able to start when the flag is
# set back to FALSE
# Is set to TRUE at the beginning of calls to ->doDraw and ->doQuickDraw, so that a
# second call to either function can't be processed while an earlier one is still in
# progress
delayDrawFlag => FALSE,
# When pre-drawing, objects are drawn in stack order, from bottom to top; in very large
# maps (thousands of rooms), GooCanvas2 can complete the drawing much more quickly
# when everything can be raised to the top of the stack, rather than being
# arbitrarily inserted somewhere in the middle
# Flag set to TRUE at the beginning of calls to ->doQuickDraw, so that individual
# drawing functions like $self->drawRoomBox, ->drawIncompleteExit (etc) can raise the
# canvas object to the top of the drawing stack every time
quickDrawFlag => FALSE,
# Drawing cycle IVs (each call to $self->doDraw is a single drawing cycle). Some of
# these IVs are also set in a call to ->doQuickDraw
#
# During the drawing cycle, regions are drawn one at a time. For each region, these IVs
# is set so individual drawing functions can quickly look up the regionmap and
# parchment object being drawn
drawRegionmap => undef,
drawParchment => undef,
drawScheme => undef,
# IV used only while the selection box is active, specifying the scheme to use (we can't
# use ->drawScheme, because other code may reset it in the meantime)
selectDrawScheme => undef,
# $self->drawCycleExitHash contains a list of exits drawn during a single drawing cycle.
# Before drawing an exit, we can check whether it has a twin exit (which occupies the
# same space) and, if so, we don't need to draw it a second time - thus each exit-twin
# exit pair is only drawn once for each call to $self->doDraw
# Hash in the form
# $drawCycleExitHash{exit_model_number} = undef
drawCycleExitHash => {},
# The size of room interior text. This value is set by $self->prepareDraw, at the start
# of every drawing cycle, to be a little bit smaller than half the width of the room
# (which depends on the draw exit mode in effect)
drawRoomTextSize => undef,
# For room interior text, the size of the usable area (which depends on the draw exit
# mode in effect). The values are also set by $self->doDraw, once per drawing cycle
drawRoomTextWidth => undef,
drawRoomTextHeight => undef,
# The size of other text drawn on the map, besides room interior text (includes room
# tags, room guilds, exit tags and labels). Also set by $self->prepareDraw, based on
# the size of a room when exits are being drawn
drawOtherTextSize => undef,
# Hashes set by $self->preDrawPositions and $self->preDrawExits (see the comments in
# those functions for a longer explanation)
# Calculates the position of each type of exit, and of a few room components, relative
# to their gridblocks, to make the drawing of rooms and exits much quicker
blockCornerXPosPixels => undef,
blockCornerYPosPixels => undef,
blockCentreXPosPixels => undef,
blockCentreYPosPixels => undef,
borderCornerXPosPixels => undef,
borderCornerYPosPixels => undef,
preDrawnIncompleteExitHash => {},
preDrawnUncertainExitHash => {},
preDrawnLongExitHash => {},
preDrawnSquareExitHash => {},
# Also calculates which primary directions should be used, if counting checked/
# checkeable directions (i.e. when $self->worldModelObj->roomInteriorMode is set to
# 'checked_count')
preCountCheckedHash => {},
# When obscured rooms are enabled, exits are only drawn for rooms near the current room,
# or for selected rooms (and selected exits), and for rooms whose rooms flags match
# those in GA::Client->constRoomNoObscuredHash (e.g. 'main_route')
# When obscured rooms are enabled, these hashes are emptied and then re-compiled by a
# call to ->doDraw, or (in anticipation of several calls to ->doQuickDraw), by
# ->preparePreDraw or ->redrawRegions
# This hash contains any rooms which are due to be drawn, which should not be obscured.
# Hash in the form
# $noObscuredRoomHash{model_number} = undef
noObscuredRoomHash => {},
# This hash contains any rooms which have been drawn un-obscured, but which are to be
# drawn re-obscured
# Hash in the form
# $reObscuredRoomHash{model_number} = undef
reObscuredRoomHash => {},
# What happens when the user clicks on the map
# 'default' - normal operation. Any selected objects are unselected
# 'add_room' - 'Add room at click' menu option - when the user clicks on the map, a
# new room is added at that location
# 'connect_exit' - 'Connect [exit] to click' menu option - when the user clicks on a
# room on the map (on any level, in any region), the exit is connected to that
# room
# 'add_label' - 'Add label at click' menu option - when the user clicks on the map, a
# new label is added at that location
# 'move_room' - 'Move selected rooms to click' menu option - when the user clicks on
# the map (probably in a new region), the selected rooms (and their room tags/room
# guilds/exits/exit tags) and labels are move to that position on the map
# 'merge_room' - 'Merge/move rooms' menu option - when the user clicks on a room on
# the map, and it's one of the rooms specified by GA::Obj::Map->currentMatchList,
# the current room is merged with the clicked room
# NB To set this IV, you must call $self->set_freeClickMode($mode) or
# $self->reset_freeClickMode() (which sets it to 'default')
freeClickMode => 'default',
# A 'move selected rooms to click' operation can also be initiated by press CTRL+C.
# $self->setKeyPressEvent needs to know when the CTRL key is being held down, so this
# flag is set to TRUE when it's held down
ctrlKeyFlag => FALSE,
# Background colour mode can be applied whenever ->freeClickMode is 'default', and is
# used to colour in gridblocks in the background canvas:
# 'default' - Normal operation. Clicks on the canvas don't affect background colour
# 'square_start' - Clicks on a gridblock colours in that gridblock
# 'rect_start' - The first click on a gridblock marks that gridblock as one corner in
# a rectangle. The mode is changed to 'rect_stop' in anticipation of the next
# click
# 'rect_stop' - The first click on a gridblock marks that gridblock as the opposite
# corner in a rectangle. The mode is changed back to 'rect_start'
bgColourMode => 'default',
# The colour to use when colouring in the background. If 'undef', colours are removed
# from gridblock(s) instead of being added. If defined, should be an RGB tag like
# '#ABCDEF' (case-insensitive)
bgColourChoice => undef,
# When $self->bgColourMode is 'rect_start' and the user clicks on the map, the value
# is changed to 'rect_stop' and the coordinates of the click are stored in these
# IVs, while waiting for a second click
bgRectXPos => undef,
bgRectYPos => undef,
# Flag set to TRUE when new coloured blocks/rectangles should be drawn on all levels,
# FALSE when new coloured blocks/squares should only be drawn on the current level
bgAllLevelFlag => FALSE,
# When working out whether the user has clicked on an exit, how closely the angle of the
# drawn exit's gradient (relative to the x-axis) must match the gradient of a line
# from the exit's origin point, to the point on the map the user clicked (in degrees)
exitSensitivity => 30,
# A value used to draw bends on bending exits
exitBendSize => 4,
# When the user right-clicks on an exit, we need to record the position of the click, in
# case the user wants to add an exit bend at that point. These IVs are reset by a
# click on any other part of the canvas
exitClickXPosn => undef,
exitClickYPosn => undef,
# GooCanvas2 signals don't recognise double clicks on canvas objects such as rooms,
# therefore we have to implement our own double-click detection code
# These IVs are set when the user left-clicks on a room, and reset when a double-click
# is detected on the same room
leftClickTime => undef,
leftClickObj => undef,
# The maximumd time (in seconds) between the two clicks
leftClickWaitTime => 0.3,
# The operating mode:
# 'wait' - The automapper isn't doing anything
# 'follow' - The automapper is following the character's position, but not
# updating the world model (except for the character visit count)
# 'update' - The automapper is following the character's position and updating the
# world model when required
mode => 'wait',
# To show visits for a different character, this IV is set to a character's name (which
# matches the name of a character profile). If set to 'undef', the current character
# profile is used
showChar => undef,
# The painter is a non-model GA::ModelObj::Room object stored in the world model. When
# this flag is set to TRUE, the painter's IVs are used to create (or update) new room
# objects; if set to FALSE, the painter is ignored
painterFlag => FALSE,
# Flag set to TRUE when 'graffiti mode' is on
graffitiModeFlag => FALSE,
# Every room the character visits while graffiti mode is on (when $self->mode is
# 'follow' or 'update') is added to this hash, and is drawn differently. The hash is
# emptied when graffiti mode is turned off (or when the window is closed)
# No changes are made to the world model because of graffiti mode (though the model is
# still updated in the normal way, with character visits and so on). If multiple
# sessions are showing the same map, other automapper windows are not affected
graffitiHash => {},
# Primary vector hash - maps Axmud's primary directions onto a vector, expressed in a
# list reference as (x, y, z), showing the direction that each primary direction takes
# us on the Axmud map
# (In the grid, the top-left corner at the highest level has coordinates 0, 0, 0)
constVectorHash => {
north => [0, -1, 0],
northnortheast => [0.5, -1, 0],
northeast => [1, -1, 0],
eastnortheast => [1, -0.5, 0],
east => [1, 0, 0],
eastsoutheast => [1, 0.5, 0],
southeast => [1, 1, 0],
southsoutheast => [0.5, 1, 0],
south => [0, 1, 0],
southsouthwest => [-0.5, 1, 0],
southwest => [-1, 1, 0],
westsouthwest => [-1, 0.5, 0],
west => [-1, 0, 0],
westnorthwest => [-1, -0.5, 0],
northwest => [-1, -1, 0],
northnorthwest => [-0.5, -1, 0],
up => [0, 0, 1],
down => [0, 0, -1],
},
# A second vector hash for drawing two-way exits (which are drawn as two parallel lines)
# Each value is expressed as a list reference (x1, y1, x2, y2)
# (x1, y1) are simply added to the coordinates of the start and stop pixels of the first
# line, and (x2, y2) are added to the start and stop pixels of the second line - this
# moves the two lines either side of where the line is normally drawn
# NB 'up' and 'down' are never drawn with double lines, so their values are both
# [0, 0, 0, 0]
constDoubleVectorHash => {
north => [-2, 0, 2, 0],
northnortheast => [-2, 0, 2, 0], # Also on top of room box, so same as N
northeast => [-2, 0, 0, 2],
eastnortheast => [0, -2, 0, 2], # Same as E
east => [0, -2, 0, 2],
eastsoutheast => [0, -2, 0, 2], # Same as E
southeast => [-2, 0, 0, -2],
southsoutheast => [-2, 0, 2, 0], # Same as S
south => [-2, 0, 2, 0],
southsouthwest => [-2, 0, 2, 0], # Same as S
southwest => [0, -2, 2, 0],
westsouthwest => [0, -2, 0, 2], # Same as W
west => [0, -2, 0, 2],
westnorthwest => [0, -2, 0, 2], # Same as W
northwest => [2, 0, 0, 2],
northnorthwest => [-2, 0, 2, 0], # Same as N
up => [0, 0, 0, 0],
down => [0, 0, 0, 0],
},
# A third vector hash for drawing one-way exits (which are drawn as a single line, with
# an arrowhead at the edge of the block, showing the exit's direction
# Each value is expressed as a list reference (x1, y1, x2, y2)
# (x1, y1) is a vector showing the direction of one half of the arrowhead, starting at
# the edge of the block. (x2, y2) is a vector showing the direction of travel of the
# other half
# NB 'up' and 'down' are never drawn with single lines, so their values are both
# [0, 0, 0, 0]
constArrowVectorHash => {
north => [-1, 1, 1, 1],
northnortheast => [-0.8, 0.5, 0.5, 0.8], # Approx. a right-angled arrowhead
northeast => [-1, 0, 0, 1],
eastnortheast => [-0.8, -0.5, -0.5, 0.8],
east => [-1, -1, -1, 1],
eastsoutheast => [-0.5, -0.8, -0.8, 0.5],
southeast => [-1, 0, 0, -1],
southsoutheast => [-0.8, -0.5, 0.5, -0.8],
south => [-1, -1, 1, -1],
southsouthwest => [-0.5, -0.8, 0.8, -0.5],
southwest => [0, -1, 1, 0],
westsouthwest => [0.5, -0.8, 0.8, 0.5],
west => [1, -1, 1, 1],
westnorthwest => [0.8, -0.5, 0.5, 0.8],
northwest => [1, 0, 0, 1],
northnorthwest => [0.8, 0.5, -0.5, 0.8],
up => [0, 0, 0, 0],
down => [0, 0, 0, 0],
},
# A fourth vector hash for drawing exit ornaments (which are drawn perpendicular to the
# exit line)
# Each value is expressed as a list reference (x1, y1, x2, y2)
# (x1, y1) is a vector showing the direction of one half of the ornament, generally
# starting in the middle of the exit line (and perpendicular to it). (x2, y2) is a
# vector showing the direction of the other half
# NB 'up' and 'down' are never drawn with single lines, so their values are both
# [0, 0, 0, 0]
constPerpVectorHash => { # 'perp' for 'perpendicular'
north => [-1, 0, 1, 0],
northnortheast => [-0.8, -0.5, 0.8, 0.5], # Approx perpendicular line
northeast => [-1, -1, 1, 1],
eastnortheast => [-0.5, -0.8, 0.5, 0.8],
east => [0, -1, 0, 1],
eastsoutheast => [0.5, -0.8, -0.5, 0.8],
southeast => [-1, 1, 1, -1],
southsoutheast => [-0.8, 0.5, 0.8, -0.5],
south => [-1, 0, 1, 0],
southsouthwest => [-0.8, -0.5, 0.8, 0.5],
southwest => [-1, -1, 1, 1],
westsouthwest => [-0.5, -0.8, 0.5, 0.8],
west => [0, -1, 0, 1],
westnorthwest => [-0.5, 0,8, 0.5, -0.8],
northwest => [-1, 1, 1, -1],
northnorthwest => [-0.8, 0.5, 0.8, -0.5],
up => [0, 0, 0, 0],
down => [0, 0, 0, 0],
},
# A fifth vector hash, a slightly modified version of ->constVectorHash, used by
# GA::Obj::Map->moveKnownDirSeen for placing new rooms on the map.
# Moves in the north-south west-east southwest-northeast and southeast-northwest
# directions are placed in adjacent gridblocks, but moves in the northnortheast (etc)
# direction have to be placed about 2 gridblocks away
constSpecialVectorHash => {
north => [0, -1, 0], # Same values used in ->constVectorHash
northnortheast => [1, -2, 0], # Double values used in ->constVectorHash
northeast => [1, -1, 0],
eastnortheast => [2, -1, 0],
east => [1, 0, 0],
eastsoutheast => [2, 1, 0],
southeast => [1, 1, 0],
southsoutheast => [1, 2, 0],
south => [0, 1, 0],
southsouthwest => [-1, 2, 0],
southwest => [-1, 1, 0],
westsouthwest => [-2, 1, 0],
west => [-1, 0, 0],
westnorthwest => [-2, -1, 0],
northwest => [-1, -1, 0],
northnorthwest => [-1, -2, 0],
up => [0, 0, 1],
down => [0, 0, -1],
},
# A hash for drawing triangles in a return exit. One of the triangle's points is at the
# pixel where an incomplete exit would start, touching the room box. The other two
# points are corners of the square used to draw broken/region exits
# $self->preDrawnSquareExitHash describes the positions of opposite corners of this
# square as:
# (top_left_x, top_left_y, bottom_right_x, bottom_right_y)
# This hash tells gives us four of these values, referred to as 0-3
# (0, 1, 2, 3)
# The first pair describes the second corner of the triangle; the second pair describes
# the third corner of the triangle
constTriangleCornerHash => {
north => [0, 1, 2, 1],
northnortheast => [0, 1, 2, 1], # Same as N
northeast => [0, 1, 2, 3],
eastnortheast => [2, 1, 2, 3], # Same as E
east => [2, 1, 2, 3],
eastsoutheast => [2, 1, 2, 3], # Same as E
southeast => [2, 1, 0, 3],
southsoutheast => [0, 3, 2, 3], # Same as S
south => [0, 3, 2, 3],
southsouthwest => [0, 3, 2, 3], # Same as S
southwest => [0, 1, 2, 3],
westsouthwest => [0, 1, 0, 3], # Same as W
west => [0, 1, 0, 3],
westnorthwest => [0, 1, 0, 3], # Same as W
northwest => [2, 1, 0, 3],
northnorthwest => [0, 1, 2, 1], # Same as N
up => [0, 0],
down => [0, 0],
},
# Anchor hashes - converts a standard primary direction into a Gtk3 anchor constant, so
# that exit tags can be drawn in the right position
constGtkAnchorHash => {
north => 'GOO_CANVAS_ANCHOR_S',
# No GooCanvas2 constant for NNE, etc, so use the same as N
northnortheast => 'GOO_CANVAS_ANCHOR_S', # Same as N
northeast => 'GOO_CANVAS_ANCHOR_SW',
eastnortheast => 'GOO_CANVAS_ANCHOR_W', # Same as E
east => 'GOO_CANVAS_ANCHOR_W',
eastsoutheast => 'GOO_CANVAS_ANCHOR_W', # Same as E
southeast => 'GOO_CANVAS_ANCHOR_NW',
southsoutheast => 'GOO_CANVAS_ANCHOR_N', # Same as S
south => 'GOO_CANVAS_ANCHOR_N',
southsouthwest => 'GOO_CANVAS_ANCHOR_N', # Same as S
southwest => 'GOO_CANVAS_ANCHOR_NE',
westsouthwest => 'GOO_CANVAS_ANCHOR_E', # Same as W
west => 'GOO_CANVAS_ANCHOR_E',
westnorthwest => 'GOO_CANVAS_ANCHOR_E', # Same as w
northwest => 'GOO_CANVAS_ANCHOR_SE',
northnorthwest => 'GOO_CANVAS_ANCHOR_S', # Same as N
},
# Magnfication list. A list of standard magnification factors used for zooming in or out
# from the map
# Each GA::Obj::Regionmap object has its own ->magnification IV, so zooming on one
# region doesn't affect the magnification of others
# When the user zooms in or out, ->magnification is set to one of the values in this
# list, and various IVs in GA::Obj::Regionmap (such as ->blockWidthPixels and
# ->roomHeightPixels) are changed. When the map is redrawn, everything in it is bigger
# (or smaller)
constMagnifyList => [
0.01, 0.02, 0.04, 0.06, 0.08, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9,
1,
1.1, 1.2, 1.35, 1.5, 2, 3, 5, 7, 10,
],
# A subset of these magnifications, used as menu items
constShortMagnifyList => [
0.5, 0.8, 1, 1.2, 1.5, 1.75, 2
],
# When some menu items are selected (e.g. View > Room filters > Release markers filter),
# a call is made to this session's GA::Obj::WorldModel, which in turn calls every
# Automapper window using the model, in order to update its menu. When this happens,
# the following flag is set to TRUE, so that updating the menu item doesn't cause
# further calls to GA::Obj::WorldModel
ignoreMenuUpdateFlag => FALSE,
# IVs used during a drag operation
# Flag set to TRUE during drag mode (set from the menu or the toolbar). Normally, it's
# necessary to hold down the Alt-Gr key to drag canvas objects; when drag mode is on,
# clicks on canvas objects are treated as the start of a drag, rather than a
# select/unselect operation)
# NB During a drag operation initiated with the Alt-Gr key, ->dragModeFlag's value
# doesn't change
dragModeFlag => FALSE,
# Flag set to TRUE when a dragging operation starts
dragFlag => FALSE,
# Flag set to TRUE when $self->continueDrag is called, and set back to FALSE at the
# end of that call. ->continueDrag does nothing if a previous call to the function
# hasn't been completed (happens a lot)
dragContinueFlag => FALSE,
# The canvas object that was underneath the mouse cursor when the drag operation began
# (the object that was grabbed, when using Alt-Gr)
dragCanvasObj => undef,
# A list of all canvas objects that are being dragged together. $self->dragCanvasObj is
# always the first item in the list
# If $self->dragCanvasObj is a room, all selected rooms/labels in the same region are
# dragged together
# If $self->dragCanvasObj is a label, both the label and its box (if drawn) are dragged
# together
dragCanvasObjList => [],
# The GA::ModelObj::Room / GA::Obj::Exit / GA::Obj::MapLabel being dragged,
# corresponding to $self->dragCanvasObj
dragModelObj => undef,
# The type of object being dragged - 'room', 'room_tag', 'room_guild', 'exit',
# 'exit_tag' or 'label'
dragModelObjType => undef,
# The canvas object's initial coordinates on the canvas
dragInitXPos => undef,
dragInitYPos => undef,
# The canvas object's current coordinates on the canvas
dragCurrentXPos => undef,
dragCurrentYPos => undef,
# When dragging a room(s), the fake room(s) drawn at the original location (so that the
# exits don't look messy)
dragFakeRoomList => [],
# When dragging an exit bend, the bend's index in the exit's list of bends (the bend
# closest to the start of the exit has the index 0)
dragBendNum => undef,
# When dragging an exit bend, the initial position of the bend, relative to the start of
# the bending section of the exit
dragBendInitXPos => undef,
dragBendInitYPos => undef,
# The corresponding IVs for the twin exit, when dragging an exit bend
dragBendTwinNum => undef,
dragBendTwinInitXPos => undef,
dragBendTwinInitYPos => undef,
# When dragging an exit bend, the exit drawing mode (corresponds to
# GA::Obj::WorldModel->drawExitMode)
dragExitDrawMode => undef,
# When dragging an exit bend, the draw ornaments flag (corresponds to
# GA:Obj::WorldModel->drawOrnamentsFlag
dragExitOrnamentsFlag => undef,
# IVs used during a selection box operation
# Flag set to TRUE when a selection box operation starts, but before the box has
# actually been drawn
selectBoxFlag => FALSE,
# The selection box's canvas object, once it has been drawn
selectBoxCanvasObj => undef,
# The canvas 's initial coordinates on the canvas
selectBoxInitXPos => undef,
selectBoxInitYPos => undef,
# The canvas object's current coordinates on the canvas
selectBoxCurrentXPos => undef,
selectBoxCurrentYPos => undef,
};
# Bless the object into existence
bless $self, $class;
return $self;
}
##################
# Methods
# Standard window object functions
sub winSetup {
# Called by GA::Obj::Workspace->createGridWin or ->createSimpleGridWin
# Creates the Gtk3::Window itself
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $title - The window title; ignored if specified ($self->setWinTitle sets the
# window title)
# $listRef - Reference to a list of functions to call, just after the Gtk3::Window is
# created (can be used to set up further ->signal_connects, if this
# window needs them)
#
# Return values
# 'undef' on improper arguments or if the window can't be opened
# 1 on success
my ($self, $title, $listRef, $check) = @_;
# Local variables
my $iv;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->winSetup', @_);
}
# Don't create a new window, if it already exists
if ($self->enabledFlag) {
return undef;
}
# Create the Gtk3::Window
my $winWidget = Gtk3::Window->new('toplevel');
if (! $winWidget) {
return undef;
} else {
# Store the IV now, as subsequent code needs it
$self->ivPoke('winWidget', $winWidget);
$self->ivPoke('winBox', $winWidget);
}
# Set up ->signal_connects (other ->signal_connects are set up in the call to
# $self->winEnable() )
$self->setDeleteEvent(); # 'delete-event'
$self->setKeyPressEvent(); # 'key-press-event'
$self->setKeyReleaseEvent(); # 'key-release-event'
$self->setFocusOutEvent(); # 'focus-out-event'
# Set up ->signal_connects specified by the calling function, if any
if ($listRef) {
foreach my $func (@$listRef) {
$self->$func();
}
}
# Set the window title. If $title wasn't specified, use a suitable default title
$self->setWinTitle();
# Set the window's default size and position (this will almost certainly be changed before
# the call to $self->winEnable() )
$winWidget->set_default_size(
$axmud::CLIENT->customGridWinWidth,
$axmud::CLIENT->customGridWinHeight,
);
$winWidget->set_border_width($axmud::CLIENT->constGridBorderPixels);
# Set the icon list for this window
$iv = $self->winType . 'WinIconList';
$winWidget->set_icon_list($axmud::CLIENT->desktopObj->{$iv});
# Draw the widgets used by this window
if (! $self->drawWidgets()) {
return undef;
}
# The calling function can now move the window into position, before calling
# $self->winEnable to make it visible, and to set up any more ->signal_connects()
return 1;
}
sub winEnable {
# Called by GA::Obj::Workspace->createGridWin or ->createSimpleGridWin
# After the Gtk3::Window has been setup and moved into position, makes it visible and calls
# any further ->signal_connects that must be not be setup until the window is visible
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $listRef - Reference to a list of functions to call, just after the Gtk3::Window is
# created (can be used to set up further ->signal_connects, if this
# window needs them)
#
# Return values
# 'undef' on improper arguments
# 1 on success
my ($self, $listRef, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->winEnable', @_);
}
# Make the window appear on the desktop
$self->winShowAll($self->_objClass . '->winEnable');
$self->ivPoke('enabledFlag', TRUE);
# For windows about to be placed on a grid, briefly minimise the window so it doesn't
# appear in the centre of the desktop before being moved to its correct workspace, size
# and position
# if ($self->workspaceGridObj && $self->winWidget eq $self->winBox) {
#
# $self->minimise();
# }
# This type of window is unique to its GA::Session (only one can be open at any time, per
# session); inform the session it has opened
$self->session->set_mapWin($self);
# Set up ->signal_connects that must not be set up until the window is visible
$self->setConfigureEvent(); # 'configure-event'
# Set up ->signal_connects specified by the calling function, if any
if ($listRef) {
foreach my $func (@$listRef) {
$self->$func();
}
}
# If the automapper object is in 'track alone' mode, disable the mode
$self->session->mapObj->set_trackAloneFlag(FALSE);
return 1;
}
sub winDisengage {
# Should not be called, in general (provides compatibility with other types of window,
# whose window objects can be destroyed without closing the windows themselves)
# If called, this function just calls $self->winDestroy and returns the result
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the window can't be disengaged
# 1 on success
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->winDisengage', @_);
}
return $self->winDestroy();
}
sub winDestroy {
# Called by GA::Obj::WorkspaceGrid->stop or by any other function
# Updates the automapper object (GA::Obj::Map), informs the parent workspace grid (if this
# 'grid' window is on a workspace grid) and the desktop object, and then destroys the
# Gtk3::Window (if it is open)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the window can't be destroyed or if it has already
# been destroyed
# 1 on success
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->winDestroy', @_);
}
if (! $self->winBox) {
# Window already destroyed in a previous call to this function
return undef;
}
# If the pause window is visible, destroy it
if ($axmud::CLIENT->busyWin) {
$self->hidePauseWin();
}
# If the automapper object knows the current world model room, and if the Locator task is
# running and knows about the current location, and if the world model flag that permits
# it is set, and if this Automapper window isn't currently in 'wait' mode, let the
# automapper go into 'track alone' mode
if (
$self->mapObj->currentRoom
&& $self->session->locatorTask
&& $self->session->locatorTask->roomObj
&& $self->worldModelObj->allowTrackAloneFlag
&& $self->mode ne 'wait'
) {
# Go into 'track alone' mode
$self->mapObj->set_trackAloneFlag(TRUE);
}
# Update the parent GA::Obj::Map in all cases
$self->mapObj->set_mapWin();
# Close any 'free' windows for which this window is a parent
foreach my $winObj ($self->ivValues('childFreeWinHash')) {
$winObj->winDestroy();
}
# Inform the parent workspace grid object (if any)
if ($self->workspaceGridObj) {
$self->workspaceGridObj->del_gridWin($self);
}
# Inform the desktop object
$axmud::CLIENT->desktopObj->del_gridWin($self);
# Destroy the Gtk3::Window
eval { $self->winBox->destroy(); };
if ($@) {
# Window can't be destroyed
return undef;
} else {
$self->ivUndef('winWidget');
$self->ivUndef('winBox');
}
# Inform the ->owner, if there is one
if ($self->owner) {
$self->owner->del_winObj($self);
}
# This type of window is unique to its GA::Session (only one can be open at any time, per
# session); inform the session it has closed
$self->session->set_mapWin();
return 1;
}
# sub winShowAll {} # Inherited from GA::Win::Generic
sub drawWidgets {
# Called by $self->winSetup
# Sets up the Gtk3::Window by drawing its widgets
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 on success
my ($self, $check) = @_;
# Local variables
my ($menuBar, $hPaned, $treeViewScroller, $canvasFrame);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawWidgets', @_);
}
# Create a packing box
my $packingBox = Gtk3::VBox->new(FALSE, 0);
$self->winBox->add($packingBox);
$packingBox->set_border_width(0);
# Update IVs immediately
$self->ivPoke('packingBox', $packingBox);
# Create a menu (if allowed)
if ($self->worldModelObj->showMenuBarFlag) {
$menuBar = $self->enableMenu();
if ($menuBar) {
# Pack the widget
$packingBox->pack_start($menuBar, FALSE, FALSE, 0);
}
}
# Create toolbar(s) at the top of the window (if allowed)
if ($self->worldModelObj->showToolbarFlag) {
# Reset toolbar IVs to their default state; the subsequent call to $self->enableToolbar
# imports the list of button sets from the world model, and updates these IVs
# accordinly
$self->resetToolbarIVs();
foreach my $toolbar ($self->enableToolbar()) {
# Pack the widget
$packingBox->pack_start($toolbar, FALSE, FALSE, 0);
}
}
# Create a horizontal pane to divide everything under the menu into two, with the treeview
# on the left, and everything else on the right (only if both the treeview and the canvas
# are shown)
if ($self->worldModelObj->showTreeViewFlag && $self->worldModelObj->showCanvasFlag) {
$hPaned = Gtk3::HPaned->new();
if ($hPaned) {
# Set the width of the space about to be filled with the treeview
$hPaned->set_position($self->treeViewWidthPixels);
# Pack the widget
$packingBox->pack_start($hPaned, TRUE, TRUE, 0);
$self->ivPoke('hPaned', $hPaned);
}
}
# Create a treeview (if allowed)
if ($self->worldModelObj->showTreeViewFlag) {
$treeViewScroller = $self->enableTreeView();
if ($treeViewScroller) {
# Pack the widget
if ($hPaned) {
# Add the treeview's scroller to the left pane
$hPaned->add1($treeViewScroller);
} else {
# Pack the treeview directly into the packing box
$packingBox->pack_start($treeViewScroller, TRUE, TRUE, 0);
}
}
}
# Create a canvas (if allowed)
if ($self->worldModelObj->showCanvasFlag) {
$canvasFrame = $self->enableCanvas();
if ($canvasFrame) {
# Pack the widget
if ($hPaned) {
# Add the frame to the right pane
$hPaned->add2($canvasFrame);
} else {
# Pack the frame directly into the packing box
$packingBox->pack_start($canvasFrame, TRUE, TRUE, 0);
}
}
}
return 1;
}
sub redrawWidgets {
# Can be called by any function
# Redraws some or all of the menu bar, toolbar(s), treeview and canvas
# The widgets redrawn are specified by the calling function, but are not redrawn if the
# right flags aren't set (e.g. the menu bar isn't redrawn if
# GA::Obj::WorldModel->showMenuBarFlag isn't set)
#
# Expected arguments
# @widgetList - A list of widget names. One or all of the following strings, in any order:
# 'menu_bar', 'toolbar', 'treeview', 'canvas'
#
# Return values
# 'undef' on improper arguments or if any of the widgets in @widgetList are unrecognised
# 1 otherwise
my ($self, @widgetList) = @_;
# Local variables
my (
$menuBar, $hPaned, $treeViewScroller, $canvasFrame,
@toolbarList,
%widgetHash,
);
# Check for improper arguments
if (! @widgetList) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->redrawWidgets', @_);
}
# Check that the strings in @widgetList are valid, and add each string into a hash so that
# no widget is drawn more than once
# Initialise the hash of allowed widgets
%widgetHash = (
'menu_bar' => FALSE,
'toolbar' => FALSE,
'treeview' => FALSE,
'canvas' => FALSE,
);
# Check everything in @widgetList
foreach my $name (@widgetList) {
if (! exists $widgetHash{$name}) {
return $self->session->writeError(
'Unrecognised widget \'' . $name . '\'',
$self->_objClass . '->redrawWidgets',
);
} else {
# If the same string appears more than once in @widgetList, we only draw the widget
# once
$widgetHash{$name} = TRUE;
}
}
# Remove the old widgets from the vertical packing box
if ($self->menuBar) {
$axmud::CLIENT->desktopObj->removeWidget($self->packingBox, $self->menuBar);
}
foreach my $toolbar ($self->toolbarList) {
$axmud::CLIENT->desktopObj->removeWidget($self->packingBox, $toolbar);
}
if ($self->hPaned) {
foreach my $child ($self->hPaned->get_children()) {
$self->hPaned->remove($child);
}
$axmud::CLIENT->desktopObj->removeWidget($self->packingBox, $self->hPaned);
} else {
if ($self->treeViewScroller) {
$axmud::CLIENT->desktopObj->removeWidget(
$self->packingBox,
$self->treeViewScroller,
);
}
if ($self->canvasFrame) {
$axmud::CLIENT->desktopObj->removeWidget($self->packingBox, $self->canvasFrame);
}
}
# Redraw the menu bar, if specified (and if allowed)
if ($self->worldModelObj->showMenuBarFlag) {
if ($widgetHash{'menu_bar'}) {
$self->resetMenuBarIVs();
my $menuBar = $self->enableMenu();
if ($menuBar) {
# Pack the new widget
$self->packingBox->pack_start($menuBar,FALSE,FALSE,0);
} else {
# After the error, stop trying to draw menu bars
$self->worldModelObj->set_showMenuBarFlag(FALSE);
}
# Otherwise, repack the old menu bar
} elsif ($self->menuBar) {
$self->packingBox->pack_start($self->menuBar,FALSE,FALSE,0);
}
}
# Redraw the toolbar(s), if specified (and if allowed)
if ($self->worldModelObj->showToolbarFlag) {
if ($widgetHash{'toolbar'}) {
# Reset toolbar IVs to their default state; the subsequent call to
# $self->enableToolbar imports the list of button sets from the world model, and
# updates these IVs accordinly
$self->resetToolbarIVs();
@toolbarList = $self->enableToolbar();
if (@toolbarList) {
foreach my $toolbar (@toolbarList) {
# Pack the new widget
$self->packingBox->pack_start($toolbar, FALSE, FALSE, 0);
}
} else {
# After the error, stop trying to draw toolbars
$self->worldModelObj->set_showToolbarFlag(FALSE);
}
# Otherwise, repack the old toolbar(s)
} else {
foreach my $toolbar ($self->toolbarList) {
$self->packingBox->pack_start($toolbar, FALSE, FALSE, 0);
}
}
} else {
# When the toolbars are next drawn, make sure the default button set is visible in the
# original (first) toolbar
$self->ivPoke('toolbarOriginalSet', $self->constToolbarDefaultSet);
}
# Create a new horizontal pane (only if both the treeview and the canvas are allowed)
if ($self->worldModelObj->showTreeViewFlag && $self->worldModelObj->showCanvasFlag) {
$hPaned = Gtk3::HPaned->new();
if ($hPaned) {
# Set the width of the space about to be filled with the treeview
$hPaned->set_position($self->treeViewWidthPixels);
# Pack the widget
$self->packingBox->pack_start($hPaned, TRUE, TRUE, 0);
$self->ivPoke('hPaned', $hPaned);
} else {
# After the error, stop trying to draw either the treeview or the canvas
$self->worldModelObj->set_showTreeViewFlag(FALSE);
$self->worldModelObj->set_showCanvasFlag(FALSE);
}
} else {
# Horizontal pane no longer required
$self->ivUndef('hPaned');
}
# Redraw the treeview, if specified (and if allowed)
if ($self->worldModelObj->showTreeViewFlag) {
if ($widgetHash{'treeview'}) {
$self->resetTreeViewIVs();
$treeViewScroller = $self->enableTreeView();
if ($treeViewScroller) {
# Pack the new widget
if ($hPaned) {
# Add the treeview's scroller to the left pane
$hPaned->add1($treeViewScroller);
} else {
# Pack the treeview directly into the packing box
$self->packingBox->pack_start($treeViewScroller, TRUE, TRUE, 0);
}
} else {
# After the error, stop trying to draw treeviews
$self->worldModelObj->set_showTreeViewFlag(FALSE);
}
# Otherwise, repack the old treeview
} elsif ($self->treeViewScroller) {
if ($hPaned) {
# Add the treeview's scroller to the left-hand pane
$hPaned->add1($self->treeViewScroller);
} else {
# Pack the treeview directly into the packing box
$self->packingBox->pack_start($self->treeViewScroller, TRUE, TRUE, 0);
}
}
}
# Redraw the canvas, if specified (and if allowed)
if ($self->worldModelObj->showCanvasFlag) {
if ($widgetHash{'canvas'}) {
$self->resetCanvasIVs();
$canvasFrame = $self->enableCanvas();
if ($canvasFrame) {
# Pack the new widget
if ($hPaned) {
# Add the frame to the right pane
$hPaned->add2($canvasFrame);
} else {
# Pack the frame directly into the packing box
$self->packingBox->pack_start($canvasFrame, TRUE, TRUE, 0);
}
} else {
# After the error, stop trying to draw canvases
$self->worldModelObj->set_showCanvasFlag(FALSE);
}
# Otherwise, repack the old canvas
} elsif ($self->canvasFrame) {
if ($hPaned) {
# Add the frame to the right-hand pane
$hPaned->add2($self->canvasFrame);
} else {
# Pack the frame directly into the packing box
$self->packingBox->pack_start($self->canvasFrame, TRUE, TRUE, 0);
}
}
}
# Now, for each widget that is no longer drawn, set default IVs
if (! $self->worldModelObj->showMenuBarFlag) {
$self->resetMenuBarIVs();
}
if (! $self->worldModelObj->showToolbarFlag) {
$self->resetToolbarIVs();
}
if (! $self->worldModelObj->showTreeViewFlag || ! $self->worldModelObj->showCanvasFlag) {
$self->ivUndef('hPaned');
}
if (! $self->worldModelObj->showTreeViewFlag) {
$self->resetTreeViewIVs();
}
if (! $self->worldModelObj->showCanvasFlag) {
$self->resetCanvasIVs();
}
# Repack complete
$self->winShowAll($self->_objClass . '->redrawWidgets');
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->redrawWidgets');
return 1;
}
# Standard 'map' window object functions
sub winReset {
# Called by GA::Obj::Map->openWin to reset an existing Automapper window
#
# Expected arguments
# $mapObj - The calling GA::Obj::Map object
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $mapObj, $check) = @_;
# Check for improper arguments
if (! defined $mapObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->winReset', @_);
}
# Set new Perl object component IVs
$self->ivPoke('mapObj', $mapObj);
$self->ivPoke('worldModelObj', $self->session->worldModelObj);
# Reset the current region
$self->ivUndef('currentRegionmap');
$self->ivUndef('currentParchment');
$self->ivEmpty('recentRegionList');
# Reset parchment objects (which destroys all canvas widgets except the empty one created
# by the call to ->resetMap)
$self->ivEmpty('parchmentHash');
$self->ivEmpty('parchmentReadyHash');
$self->ivEmpty('parchmentQueueList');
# Reset selected objects
$self->ivUndef('selectedRoom');
$self->ivUndef('selectedExit');
$self->ivUndef('selectedRoomTag');
$self->ivUndef('selectedRoomGuild');
$self->ivUndef('selectedLabel');
$self->ivEmpty('selectedRoomHash');
$self->ivEmpty('selectedExitHash');
$self->ivEmpty('selectedRoomTagHash');
$self->ivEmpty('selectedRoomGuildHash');
$self->ivEmpty('selectedLabelHash');
# Reset drawing cycle IVs
$self->tidyUpDraw();
$self->ivEmpty('drawCycleExitHash');
# Reset other IVs to their default values
$self->reset_freeClickMode();
$self->ivPoke('mode', 'wait');
$self->ivUndef('showChar'); # Show character visits for the current character
$self->ivPoke('emptyMapFlag', FALSE);
$self->ivPoke('winUpdateCalledFlag', FALSE);
# Reset the title bar
$self->setWinTitle();
# Reset window components
$self->redrawWidgets('menu_bar', 'toolbar', 'treeview', 'canvas');
return 1;
}
sub winUpdate {
# Called by GA::Session->spinMaintainLoop or by any other code
# Check all of the automapper window's parchment objects (Games::Axmud::Obj::Parchment)
# If there are any canvas objects waiting in queue to be drawn, mark a number of them to be
# drawn
# Then draw everything that's been marked to be drawn
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if a drawing cycle (i.e. a call to $self->doDraw) is
# already in progress
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($parchmentObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->winUpdate', @_);
}
# If a drawing cycle (i.e. a call to $self->doDraw) is already in progress, don't do
# anything this time; wait for the next spin of the session's maintain loop
if ($self->delayDrawFlag || ! $self->mapObj) {
return undef;
}
# If this is the first call to this function since the window opened (or was reset),
# compile a list of regions that should be pre-drawn
if (! $self->winUpdateCalledFlag) {
$self->ivPoke('winUpdateCalledFlag', TRUE);
$self->preparePreDraw();
}
# We only draw things from the first parchment object in the list (if any)
$parchmentObj = $self->ivFirst('parchmentQueueList');
if ($parchmentObj) {
# We call ->doQuickDraw, rather than calling the standard ->doDraw function, as the
# former is optimised for drawing a whole region
# The TRUE flag tells ->doQuickDraw to apply a limit to the number of rooms, exits
# and/or labels drawn
$self->doQuickDraw($parchmentObj, TRUE);
# If the parchment has no more queued drawing operations, we can remove it from the
# queue
if (
! $parchmentObj->queueRoomEchoHash && ! $parchmentObj->queueRoomBoxHash
&& ! $parchmentObj->queueRoomTextHash && ! $parchmentObj->queueRoomExitHash
&& ! $parchmentObj->queueRoomInfoHash && ! $parchmentObj->queueLabelHash
) {
$self->ivShift('parchmentQueueList');
$self->ivAdd('parchmentReadyHash', $parchmentObj->name, $parchmentObj);
# Show the next region to be pre-drawn (if any) in the window's title bar
$self->setWinTitle();
}
}
# If a recent call to $self->doDraw failed because a drawing cycle was already in progress,
# call ->doDraw now to complete that operation
if ($self->winUpdateForceFlag) {
if ($self->doDraw()) {
$self->ivPoke('winUpdateForceFlag', FALSE);
# If the failed call to ->doDraw came from ->setCurrentRegion, then we can make the
# current region's canvas widget visible, now that the map is fully drawn
if ($self->winUpdateShowFlag) {
$self->ivPoke('winUpdateShowFlag', FALSE);
$self->swapCanvasWidget();
}
}
}
return 1;
}
# ->signal_connects
sub setDeleteEvent {
# Called by $self->winSetup
# Set up a ->signal_connect to watch out for the user manually closing the 'map' window
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setDeleteEvent', @_);
}
$self->winBox->signal_connect('delete-event' => sub {
# Prevent Gtk3 from taking action directly. Instead redirect the request to
# $self->winDestroy, which does things like resetting a portion of the workspace
# grid, as well as actually destroying the window
return $self->winDestroy();
});
return 1;
}
sub setKeyPressEvent {
# Called by $self->winSetup
# Set up a ->signal_connect to watch out for certain key presses
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the ->signal_connect doesn't interfere with the key
# press
# 1 if the ->signal_connect does interfere with the key press, or when the
# ->signal_connect is first set up
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setKeyPressEvent', @_);
}
$self->winBox->signal_connect('key-press-event' => sub {
my ($widget, $event) = @_;
# Local variables
my ($keycode, $standard);
# Get the system keycode for this keypress
$keycode = Gtk3::Gdk::keyval_name($event->keyval);
# Translate it into a standard Axmud keycode
$standard = $axmud::CLIENT->reverseKeycode($keycode);
# Respond to the keypress. The only key combination that interests the automapper is
# CTRL+C
if ($standard eq 'ctrl') {
$self->ivPoke('ctrlKeyFlag', TRUE);
}
if ($standard eq 'c' && $self->ctrlKeyFlag && $self->worldModelObj->allowCtrlCopyFlag) {
# If there are one or more selected rooms, start a 'move selected room to click'
# operation
if ($self->selectedRoom || $self->selectedRoomHash) {
$self->set_freeClickMode('move_room');
}
return 1;
} else {
return undef;
}
});
return 1;
}
sub setKeyReleaseEvent {
# Called by $self->winSetup
# Set up a ->signal_connect to watch out for certain key releases
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the ->signal_connect doesn't interfere with the key
# release
# 1 if the ->signal_connect does interfere with the key release, or when the
# ->signal_connect is first set up
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setKeyReleaseEvent', @_);
}
$self->winBox->signal_connect('key-release-event' => sub {
my ($widget, $event) = @_;
# Local variables
my ($keycode, $standard);
# Get the system keycode for this keypress
$keycode = Gtk3::Gdk::keyval_name($event->keyval);
# Translate it into a standard Axmud keycode
$standard = $axmud::CLIENT->reverseKeycode($keycode);
# Respond to the key release. The only key combination that interests the automapper is
# CTRL+C
if ($standard && $standard eq 'ctrl') {
$self->ivPoke('ctrlKeyFlag', FALSE);
}
# Return 'undef' to show that we haven't interfered with this keypress
return undef;
});
return 1;
}
sub setConfigureEvent {
# Called by $self->winEnable
# Set up a ->signal_connect to watch out for changes in the window size and position
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setConfigureEvent', @_);
}
$self->winBox->signal_connect('configure-event' => sub {
my ($widget, $event) = @_;
# Let the GA::Client store the most recent size and position for a window of this
# ->winName, if it needs to
if ($self->winWidget) {
$axmud::CLIENT->add_storeGridPosn(
$self,
$self->winWidget->get_position(),
$self->winWidget->get_size(),
);
}
# Without returning 'undef', the window's strip/table objects aren't resized along with
# the window
return undef;
});
return 1;
}
sub setFocusOutEvent {
# Called by $self->winSetup
# Set up a ->signal_connect to watch out for the 'map' window losing the focus
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setFocusInEvent', @_);
}
$self->winBox->signal_connect('focus-out-event' => sub {
my ($widget, $event) = @_;
# If the tooltips are visible, hide them
if ($event->type eq 'focus-change' && $self->canvasTooltipFlag) {
$self->hideTooltips();
}
});
return 1;
}
# Other functions
sub resetMenuBarIVs {
# Called by $self->redrawWidgets at certain points, to reset the IVs storing details about
# the menu bar back to their defaults
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetMenuBarIVs', @_);
}
$self->ivUndef('menuBar');
$self->ivEmpty('menuToolItemHash');
return 1;
}
sub resetToolbarIVs {
# Called by $self->drawWidgets and $self->redrawWidget to reset the IVs storing details
# about toolbars back to their defaults
# (If $self->enableToolbar is then called, it's that function which imports a list of
# button sets from the world model and updates these IVs accordinly)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetToolbarIVs', @_);
}
foreach my $key ($self->ivKeys('buttonSetHash')) {
$self->ivAdd('buttonSetHash', $key, FALSE);
}
$self->ivEmpty('toolbarList');
$self->ivEmpty('toolbarHash');
return 1;
}
sub resetTreeViewIVs {
# Called by $self->redrawWidgets at certain points, to reset the IVs storing details about
# the treeview back to their defaults
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetTreeViewIVs', @_);
}
$self->ivUndef('treeViewModel');
$self->ivUndef('treeView');
$self->ivUndef('treeViewScroller');
$self->ivUndef('treeViewSelectedLine');
$self->ivEmpty('treeViewRegionHash');
$self->ivEmpty('treeViewPointerHash');
return 1;
}
sub resetCanvasIVs {
# Called by $self->redrawWidgets at certain points, to reset the IVs storing details about
# the canvas back to their defaults
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetCanvasIVs', @_);
}
$self->ivUndef('canvas');
$self->ivUndef('canvasBackground');
# (For some reason, commenting out these lines decreases the draw time, during a call to
# $self->redrawWidgets, by about 40%. The IVs receive their correct values anyway when
# ->enableCanvas is called)
# $self->ivUndef('canvasFrame');
# $self->ivUndef('canvasScroller');
$self->ivUndef('canvasHAdjustment');
$self->ivUndef('canvasVAdjustment');
$self->ivUndef('canvasTooltipObj');
$self->ivUndef('canvasTooltipObjType');
$self->ivUndef('canvasTooltipFlag');
return 1;
}
# Menu widget methods
sub enableMenu {
# Called by $self->drawWidgets
# Sets up the Automapper window's Gtk3::MenuBar widget
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::MenuBar created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableMenu', @_);
}
# Create the menu bar
my $menuBar = Gtk3::MenuBar->new();
if (! $menuBar) {
return undef;
}
# 'File' column
my $column_file = $self->enableFileColumn();
my $item_file = Gtk3::MenuItem->new('_File');
$item_file->set_submenu($column_file);
$menuBar->append($item_file);
# 'Edit' column
my $column_edit = $self->enableEditColumn();
my $item_edit = Gtk3::MenuItem->new('_Edit');
$item_edit->set_submenu($column_edit);
$menuBar->append($item_edit);
# 'View' column
my $column_view = $self->enableViewColumn();
my $item_view = Gtk3::MenuItem->new('_View');
$item_view->set_submenu($column_view);
$menuBar->append($item_view);
# 'Mode' column
my $column_mode = $self->enableModeColumn();
my $item_mode = Gtk3::MenuItem->new('_Mode');
$item_mode->set_submenu($column_mode);
$menuBar->append($item_mode);
# 'Regions' column
my $column_regions = $self->enableRegionsColumn();
my $item_regions = Gtk3::MenuItem->new('_Regions');
$item_regions->set_submenu($column_regions);
$menuBar->append($item_regions);
# 'Rooms' column
my $column_rooms = $self->enableRoomsColumn();
my $item_rooms = Gtk3::MenuItem->new('R_ooms');
$item_rooms->set_submenu($column_rooms);
$menuBar->append($item_rooms);
# 'Exits' column
my $column_exits = $self->enableExitsColumn();
my $item_exits = Gtk3::MenuItem->new('E_xits');
$item_exits->set_submenu($column_exits);
$menuBar->append($item_exits);
# 'Labels' column
my $column_labels = $self->enableLabelsColumn();
my $item_labels = Gtk3::MenuItem->new('_Labels');
$item_labels->set_submenu($column_labels);
$menuBar->append($item_labels);
# Store the widget
$self->ivPoke('menuBar', $menuBar);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# Setup complete
return $menuBar;
}
sub enableFileColumn {
# Called by $self->enableMenu
# Sets up the 'File' column of the Automapper window's menu bar
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableFileColumn', @_);
}
# Set up column
my $column_file = Gtk3::Menu->new();
if (! $column_file) {
return undef;
}
my $item_loadModel = Gtk3::MenuItem->new('_Load world model');
$item_loadModel->signal_connect('activate' => sub {
# $self->winReset will be called by $self->set_worldModelObj when the ';load' command
# has finished its work
# NB Force pseudo command mode 'win_error' in this menu column (success system messages
# in the 'main' window; errors/improper arguments messages shown in a 'dialogue'
# window)
$self->session->pseudoCmd('load -m', 'win_error');
});
$column_file->append($item_loadModel);
my $item_loadAll = Gtk3::ImageMenuItem->new('L_oad all files');
$item_loadAll->signal_connect('activate' => sub {
# The ';load' command will $self->winReset when finished
$self->session->pseudoCmd('load', 'win_error');
});
my $img_loadAll = Gtk3::Image->new_from_stock('gtk-open', 'menu');
$item_loadAll->set_image($img_loadAll);
$column_file->append($item_loadAll);
$column_file->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_saveModel = Gtk3::MenuItem->new('_Save world model');
$item_saveModel->signal_connect('activate' => sub {
# Do a forced save. The ';save' command sets $self->freeClickMode back to 'default'
$self->session->pseudoCmd('save -m -f', 'win_error');
});
$column_file->append($item_saveModel);
my $item_saveAll = Gtk3::ImageMenuItem->new('S_ave all files');
$item_saveAll->signal_connect('activate' => sub {
# Do a forced save. The ';save' command sets $self->freeClickMode back to 'default'
$self->session->pseudoCmd('save -f', 'win_error');
});
my $img_saveAll = Gtk3::Image->new_from_stock('gtk-save', 'menu');
$item_saveAll->set_image($img_saveAll);
$column_file->append($item_saveAll);
$column_file->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_importModel = Gtk3::MenuItem->new('_Import/load world model...');
$item_importModel->signal_connect('activate' => sub {
$self->importModelCallback();
});
$column_file->append($item_importModel);
my $item_exportModel = Gtk3::MenuItem->new('Save/_export world model...');
$item_exportModel->signal_connect('activate' => sub {
$self->exportModelCallback();
});
$column_file->append($item_exportModel);
$column_file->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_mergeModel = Gtk3::MenuItem->new('_Merge world models...');
$item_mergeModel->signal_connect('activate' => sub {
$self->session->pseudoCmd('mergemodel')
});
$column_file->append($item_mergeModel);
$column_file->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_closeWindow = Gtk3::ImageMenuItem->new('_Close window');
$item_closeWindow->signal_connect('activate' => sub {
$self->winDestroy();
});
my $img_closeWindow = Gtk3::Image->new_from_stock('gtk-quit', 'menu');
$item_closeWindow->set_image($img_closeWindow);
$column_file->append($item_closeWindow);
# Setup complete
return $column_file;
}
sub enableEditColumn {
# Called by $self->enableMenu
# Sets up the 'Edit' column of the Automapper window's menu bar
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Local variables
my $winObj;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableEditColumn', @_);
}
# Set up column
my $column_edit = Gtk3::Menu->new();
if (! $column_edit) {
return undef;
}
# 'Select' submenu
my $subMenu_select = Gtk3::Menu->new();
# 'Select rooms' sub-submenu
my $subSubMenu_selectRooms = Gtk3::Menu->new();
my $item_selectNoTitle = Gtk3::MenuItem->new('Rooms with no _titles');
$item_selectNoTitle->signal_connect('activate' => sub {
$self->selectRoomCallback('no_title');
});
$subSubMenu_selectRooms->append($item_selectNoTitle);
my $item_selectNoDescrip = Gtk3::MenuItem->new('Rooms with no _descriptions');
$item_selectNoDescrip->signal_connect('activate' => sub {
$self->selectRoomCallback('no_descrip');
});
$subSubMenu_selectRooms->append($item_selectNoDescrip);
my $item_selectNoTitleDescrip = Gtk3::MenuItem->new('Rooms with _neither');
$item_selectNoTitleDescrip->signal_connect('activate' => sub {
$self->selectRoomCallback('no_title_descrip');
});
$subSubMenu_selectRooms->append($item_selectNoTitleDescrip);
my $item_selectTitleDescrip = Gtk3::MenuItem->new('Rooms with _both');
$item_selectTitleDescrip->signal_connect('activate' => sub {
$self->selectRoomCallback('title_descrip');
});
$subSubMenu_selectRooms->append($item_selectTitleDescrip);
$subSubMenu_selectRooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_selectNoVisitChar = Gtk3::MenuItem->new('Rooms not visited by _character');
$item_selectNoVisitChar->signal_connect('activate' => sub {
$self->selectRoomCallback('no_visit_char');
});
$subSubMenu_selectRooms->append($item_selectNoVisitChar);
my $item_selectNoVisitAllChar = Gtk3::MenuItem->new('Rooms not visited by _anyone');
$item_selectNoVisitAllChar->signal_connect('activate' => sub {
$self->selectRoomCallback('no_visit_all');
});
$subSubMenu_selectRooms->append($item_selectNoVisitAllChar);
my $item_selectVisitChar = Gtk3::MenuItem->new('Rooms visited by c_haracter');
$item_selectVisitChar->signal_connect('activate' => sub {
$self->selectRoomCallback('visit_char');
});
$subSubMenu_selectRooms->append($item_selectVisitChar);
my $item_selectVisitAllChar = Gtk3::MenuItem->new('Rooms visited by an_yone');
$item_selectVisitAllChar->signal_connect('activate' => sub {
$self->selectRoomCallback('visit_all');
});
$subSubMenu_selectRooms->append($item_selectVisitAllChar);
$subSubMenu_selectRooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_selectCheckable = Gtk3::MenuItem->new('Rooms with checkable d_irections');
$item_selectCheckable->signal_connect('activate' => sub {
$self->selectRoomCallback('checkable');
});
$subSubMenu_selectRooms->append($item_selectCheckable);
my $item_selectRooms = Gtk3::MenuItem->new('Select _rooms');
$item_selectRooms->set_submenu($subSubMenu_selectRooms);
$subMenu_select->append($item_selectRooms);
# 'Select exits' sub-submenu
my $subSubMenu_selectExits = Gtk3::Menu->new();
my $item_selectInRooms = Gtk3::MenuItem->new('Exits in selected _rooms');
$item_selectInRooms->signal_connect('activate' => sub {
$self->selectExitTypeCallback('in_rooms');
});
$subSubMenu_selectExits->append($item_selectInRooms);
$subSubMenu_selectExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_selectUnallocated = Gtk3::MenuItem->new('_Unallocated exits');
$item_selectUnallocated->signal_connect('activate' => sub {
$self->selectExitTypeCallback('unallocated');
});
$subSubMenu_selectExits->append($item_selectUnallocated);
my $item_selectUnallocatable = Gtk3::MenuItem->new('U_nallocatable exits');
$item_selectUnallocatable->signal_connect('activate' => sub {
$self->selectExitTypeCallback('unallocatable');
});
$subSubMenu_selectExits->append($item_selectUnallocatable);
my $item_selectUncertain = Gtk3::MenuItem->new('Un_certain exits');
$item_selectUncertain->signal_connect('activate' => sub {
$self->selectExitTypeCallback('uncertain');
});
$subSubMenu_selectExits->append($item_selectUncertain);
my $item_selectIncomplete = Gtk3::MenuItem->new('_Incomplete exits');
$item_selectIncomplete->signal_connect('activate' => sub {
$self->selectExitTypeCallback('incomplete');
});
$subSubMenu_selectExits->append($item_selectIncomplete);
my $item_selectAllAbove = Gtk3::MenuItem->new('_All of the above');
$item_selectAllAbove->signal_connect('activate' => sub {
$self->selectExitTypeCallback('all_above');
});
$subSubMenu_selectExits->append($item_selectAllAbove);
$subSubMenu_selectExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_selectImpassable = Gtk3::MenuItem->new('I_mpassable exits');
$item_selectImpassable->signal_connect('activate' => sub {
$self->selectExitTypeCallback('impass');
});
$subSubMenu_selectExits->append($item_selectImpassable);
my $item_selectMystery = Gtk3::MenuItem->new('M_ystery exits');
$item_selectMystery->signal_connect('activate' => sub {
$self->selectExitTypeCallback('mystery');
});
$subSubMenu_selectExits->append($item_selectMystery);
$subSubMenu_selectExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_selectNonSuper = Gtk3::MenuItem->new('R_egion exits');
$item_selectNonSuper->signal_connect('activate' => sub {
$self->selectExitTypeCallback('region');
});
$subSubMenu_selectExits->append($item_selectNonSuper);
my $item_selectSuper = Gtk3::MenuItem->new('_Super-region exits');
$item_selectSuper->signal_connect('activate' => sub {
$self->selectExitTypeCallback('super');
});
$subSubMenu_selectExits->append($item_selectSuper);
my $item_selectExits = Gtk3::MenuItem->new('Select _exits');
$item_selectExits->set_submenu($subSubMenu_selectExits);
$subMenu_select->append($item_selectExits);
$subMenu_select->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Select in region' sub-submenu
my $subSubMenu_selectRegion = Gtk3::Menu->new();
my $item_selectRegionRoom = Gtk3::MenuItem->new('Every _room');
$item_selectRegionRoom->signal_connect('activate' => sub {
$self->selectInRegionCallback('room');
});
$subSubMenu_selectRegion->append($item_selectRegionRoom);
my $item_selectRegionExit = Gtk3::MenuItem->new('Every _exit');
$item_selectRegionExit->signal_connect('activate' => sub {
$self->selectInRegionCallback('exit');
});
$subSubMenu_selectRegion->append($item_selectRegionExit);
my $item_selectRegionRoomTag = Gtk3::MenuItem->new('Every room _tag');
$item_selectRegionRoomTag->signal_connect('activate' => sub {
$self->selectInRegionCallback('room_tag');
});
$subSubMenu_selectRegion->append($item_selectRegionRoomTag);
my $item_selectRegionRoomGuild = Gtk3::MenuItem->new('Every room _guild');
$item_selectRegionRoomGuild->signal_connect('activate' => sub {
$self->selectInRegionCallback('room_guild');
});
$subSubMenu_selectRegion->append($item_selectRegionRoomGuild);
my $item_selectRegionLabel = Gtk3::MenuItem->new('Every _label');
$item_selectRegionLabel->signal_connect('activate' => sub {
$self->selectInRegionCallback('label');
});
$subSubMenu_selectRegion->append($item_selectRegionLabel);
$subSubMenu_selectRegion->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_selectRegionAbove = Gtk3::MenuItem->new('_All of the above');
$item_selectRegionAbove->signal_connect('activate' => sub {
$self->selectInRegionCallback();
});
$subSubMenu_selectRegion->append($item_selectRegionAbove);
my $item_selectRegion = Gtk3::MenuItem->new('Select in re_gion');
$item_selectRegion->set_submenu($subSubMenu_selectRegion);
$subMenu_select->append($item_selectRegion);
# 'Select in map' sub-submenu
my $subSubMenu_selectMap = Gtk3::Menu->new();
my $item_selectMapRoom = Gtk3::MenuItem->new('Every _room');
$item_selectMapRoom->signal_connect('activate' => sub {
$self->selectInMapCallback('room');
});
$subSubMenu_selectMap->append($item_selectMapRoom);
my $item_selectMapExit = Gtk3::MenuItem->new('Every _exit');
$item_selectMapExit->signal_connect('activate' => sub {
$self->selectInMapCallback('exit');
});
$subSubMenu_selectMap->append($item_selectMapExit);
my $item_selectMapRoomTag = Gtk3::MenuItem->new('Every room _tag');
$item_selectMapRoomTag->signal_connect('activate' => sub {
$self->selectInMapCallback('room_tag');
});
$subSubMenu_selectMap->append($item_selectMapRoomTag);
my $item_selectMapRoomGuild = Gtk3::MenuItem->new('Every room _guild');
$item_selectMapRoomGuild->signal_connect('activate' => sub {
$self->selectInMapCallback('room_guild');
});
$subSubMenu_selectMap->append($item_selectMapRoomGuild);
my $item_selectMapLabel = Gtk3::MenuItem->new('Every _label');
$item_selectMapLabel->signal_connect('activate' => sub {
$self->selectInMapCallback('label');
});
$subSubMenu_selectMap->append($item_selectMapLabel);
$subSubMenu_selectMap->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_selectMapAbove = Gtk3::MenuItem->new('_All of the above');
$item_selectMapAbove->signal_connect('activate' => sub {
$self->selectInMapCallback();
});
$subSubMenu_selectMap->append($item_selectMapAbove);
my $item_selectMap = Gtk3::MenuItem->new('Select in _map');
$item_selectMap->set_submenu($subSubMenu_selectMap);
$subMenu_select->append($item_selectMap);
my $item_select = Gtk3::MenuItem->new('_Select');
$item_select->set_submenu($subMenu_select);
$column_edit->append($item_select);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'select', $item_select);
# 'Selected items' submenu
my $subMenu_selectedObjs = Gtk3::Menu->new();
my $item_identifyRoom = Gtk3::MenuItem->new('Identify _room(s)');
$item_identifyRoom->signal_connect('activate' => sub {
$self->identifyRoomsCallback();
});
$subMenu_selectedObjs->append($item_identifyRoom);
# (Requires $self->currentRegionmap and EITHER $self->selectedRoom or
# $self->selectedRoomHash or $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'identify_room', $item_identifyRoom);
my $item_identifyExit = Gtk3::MenuItem->new('Identify _exit(s)');
$item_identifyExit->signal_connect('activate' => sub {
$self->identifyExitsCallback();
});
$subMenu_selectedObjs->append($item_identifyExit);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'identify_exit', $item_identifyExit);
my $item_selectedObjs = Gtk3::MenuItem->new('_Identify selected items');
$item_selectedObjs->set_submenu($subMenu_selectedObjs);
$column_edit->append($item_selectedObjs);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'selected_objs', $item_selectedObjs);
my $item_unselectAll = Gtk3::MenuItem->new('_Unselect all');
$item_unselectAll->signal_connect('activate' => sub {
$self->setSelectedObj();
});
$column_edit->append($item_unselectAll);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'unselect_all', $item_unselectAll);
$column_edit->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Search' submenu
my $subMenu_search = Gtk3::Menu->new();
my $item_searchModel = Gtk3::MenuItem->new('Search world _model...');
$item_searchModel->signal_connect('activate' => sub {
# Open a 'pref' window to conduct the search
$self->createFreeWin(
'Games::Axmud::PrefWin::Search',
$self,
$self->session,
'World model search',
);
});
$subMenu_search->append($item_searchModel);
$subMenu_search->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_findRoom = Gtk3::MenuItem->new('Find _room...');
$item_findRoom->signal_connect('activate' => sub {
$self->findRoomCallback();
});
$subMenu_search->append($item_findRoom);
my $item_findExit = Gtk3::MenuItem->new('Find _exit...');
$item_findExit->signal_connect('activate' => sub {
$self->findExitCallback();
});
$subMenu_search->append($item_findExit);
my $item_search = Gtk3::ImageMenuItem->new('S_earch');
my $img_search = Gtk3::Image->new_from_stock('gtk-find', 'menu');
$item_search->set_image($img_search);
$item_search->set_submenu($subMenu_search);
$column_edit->append($item_search);
# 'Generate reports' submenu
my $subMenu_reports = Gtk3::Menu->new();
my $item_showSummary = Gtk3::MenuItem->new('_Show general report');
$item_showSummary->signal_connect('activate' => sub {
# (Don't use $self->pseudoCmdMode - we want to see the footer messages)
$self->session->pseudoCmd('modelreport', 'show_all');
});
$subMenu_reports->append($item_showSummary);
my $item_showCurrentRegion = Gtk3::MenuItem->new('S_how current region');
$item_showCurrentRegion->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -r <' . $self->currentRegionmap->name . '>',
'show_all',
);
});
$subMenu_reports->append($item_showCurrentRegion);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'report_region', $item_showCurrentRegion);
$subMenu_reports->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Character visits' sub-submenu
my $subSubMenu_visits = Gtk3::Menu->new();
my $item_visits1 = Gtk3::MenuItem->new('_All regions/characters');
$item_visits1->signal_connect('activate' => sub {
$self->session->pseudoCmd('modelreport -v', 'show_all');
});
$subSubMenu_visits->append($item_visits1);
my $item_visits2 = Gtk3::MenuItem->new('Current _region');
$item_visits2->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -v -r <' . $self->currentRegionmap->name . '>',
'show_all',
);
});
$subSubMenu_visits->append($item_visits2);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'report_visits_2', $item_visits2);
my $item_visits3 = Gtk3::MenuItem->new('Current _character');
$item_visits3->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -v -c <' . $self->session->currentChar->name . '>',
'show_all',
);
});
$subSubMenu_visits->append($item_visits3);
# (Requires current character profile)
$self->ivAdd('menuToolItemHash', 'report_visits_3', $item_visits3);
my $item_visits4 = Gtk3::MenuItem->new('C_urrent region/character');
$item_visits4->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -v -r <' . $self->currentRegionmap->name . '>' . ' -c <'
. $self->session->currentChar->name . '>',
'show_all',
);
});
$subSubMenu_visits->append($item_visits4);
# (Requires $self->currentRegionmap and current character profile)
$self->ivAdd('menuToolItemHash', 'report_visits_4', $item_visits4);
my $item_visits = Gtk3::MenuItem->new('_Character visits');
$item_visits->set_submenu($subSubMenu_visits);
$subMenu_reports->append($item_visits);
# 'Room guilds' sub-submenu
my $subSubMenu_guilds = Gtk3::Menu->new();
my $item_guilds1 = Gtk3::MenuItem->new('_All regions/guilds');
$item_guilds1->signal_connect('activate' => sub {
$self->session->pseudoCmd('modelreport -g', 'show_all');
});
$subSubMenu_guilds->append($item_guilds1);
my $item_guilds2 = Gtk3::MenuItem->new('Current _region');
$item_guilds2->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -g -r <' . $self->currentRegionmap->name . '>',
'show_all',
);
});
$subSubMenu_guilds->append($item_guilds2);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'report_guilds_2', $item_guilds2);
my $item_guilds3 = Gtk3::MenuItem->new('Current _guild');
$item_guilds3->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -g -n <' . $self->session->currentGuild->name . '>',
'show_all',
);
});
$subSubMenu_guilds->append($item_guilds3);
# (Requires current guild profile)
$self->ivAdd('menuToolItemHash', 'report_guilds_3', $item_guilds3);
my $item_guilds4 = Gtk3::MenuItem->new('C_urrent region/guild');
$item_guilds4->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -g -r <' . $self->currentRegionmap->name . '>' . ' -n <'
. $self->session->currentGuild->name . '>',
'show_all',
);
});
$subSubMenu_guilds->append($item_guilds4);
# (Requires $self->currentRegionmap and current guild profile)
$self->ivAdd('menuToolItemHash', 'report_guilds_4', $item_guilds4);
my $item_guilds = Gtk3::MenuItem->new('Room _guilds');
$item_guilds->set_submenu($subSubMenu_guilds);
$subMenu_reports->append($item_guilds);
# 'Room flags' sub-submenu
my $subSubMenu_roomFlags = Gtk3::Menu->new();
my $item_roomFlags1 = Gtk3::MenuItem->new('_All regions/flags');
$item_roomFlags1->signal_connect('activate' => sub {
$self->session->pseudoCmd('modelreport -f', 'show_all');
});
$subSubMenu_roomFlags->append($item_roomFlags1);
my $item_roomFlags2 = Gtk3::MenuItem->new('Current _region');
$item_roomFlags2->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -f -r <' . $self->currentRegionmap->name . '>',
'show_all',
);
});
$subSubMenu_roomFlags->append($item_roomFlags2);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'report_flags_2', $item_roomFlags2);
my $item_roomFlags3 = Gtk3::MenuItem->new('_Specify flag...');
$item_roomFlags3->signal_connect('activate' => sub {
my (
$choice,
@list,
);
@list = $self->worldModelObj->roomFlagOrderedList;
$choice = $self->showComboDialogue(
'Select room flag',
'Select one of the world model\'s room flags',
\@list,
);
if ($choice) {
$self->session->pseudoCmd(
'modelreport -f -l <' . $choice . '>',
'show_all',
);
}
});
$subSubMenu_roomFlags->append($item_roomFlags3);
my $item_roomFlags4 = Gtk3::MenuItem->new('C_urrent region/specify flag...');
$item_roomFlags4->signal_connect('activate' => sub {
my (
$choice,
@list,
);
@list = $self->worldModelObj->roomFlagOrderedList;
$choice = $self->showComboDialogue(
'Select room flag',
'Select one of the world model\'s room flags',
\@list,
);
if ($choice) {
$self->session->pseudoCmd(
'modelreport -f -r <' . $self->currentRegionmap->name . '>' . ' -l <'
. $choice . '>',
'show_all',
);
}
});
$subSubMenu_roomFlags->append($item_roomFlags4);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'report_flags_4', $item_roomFlags4);
my $item_roomFlags = Gtk3::MenuItem->new('Room _flags');
$item_roomFlags->set_submenu($subSubMenu_roomFlags);
$subMenu_reports->append($item_roomFlags);
# 'Rooms' sub-submenu
my $subSubMenu_rooms = Gtk3::Menu->new();
my $item_rooms1 = Gtk3::MenuItem->new('_All regions');
$item_rooms1->signal_connect('activate' => sub {
$self->session->pseudoCmd('modelreport -m', 'show_all');
});
$subSubMenu_rooms->append($item_rooms1);
my $item_rooms2 = Gtk3::MenuItem->new('_Current region');
$item_rooms2->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -m -r <' . $self->currentRegionmap->name . '>',
'show_all',
);
});
$subSubMenu_rooms->append($item_rooms2);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'report_rooms_2', $item_rooms2);
my $item_rooms = Gtk3::MenuItem->new('_Rooms');
$item_rooms->set_submenu($subSubMenu_rooms);
$subMenu_reports->append($item_rooms);
# 'Exits' sub-submenu
my $subSubMenu_exits = Gtk3::Menu->new();
my $item_exits1 = Gtk3::MenuItem->new('_All regions');
$item_exits1->signal_connect('activate' => sub {
$self->session->pseudoCmd('modelreport -x', 'show_all');
});
$subSubMenu_exits->append($item_exits1);
my $item_exits2 = Gtk3::MenuItem->new('_Current region');
$item_exits2->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -x -r <' . $self->currentRegionmap->name . '>',
'show_all',
);
});
$subSubMenu_exits->append($item_exits2);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'report_exits_2', $item_exits2);
my $item_exits = Gtk3::MenuItem->new('_Exits');
$item_exits->set_submenu($subSubMenu_exits);
$subMenu_reports->append($item_exits);
# 'Checked directions' sub-submenu
my $subSubMenu_checked = Gtk3::Menu->new();
my $item_checked1 = Gtk3::MenuItem->new('_All regions');
$item_checked1->signal_connect('activate' => sub {
$self->session->pseudoCmd('modelreport -h', 'show_all');
});
$subSubMenu_checked->append($item_checked1);
my $item_checked2 = Gtk3::MenuItem->new('_Current region');
$item_checked2->signal_connect('activate' => sub {
$self->session->pseudoCmd(
'modelreport -h -r <' . $self->currentRegionmap->name . '>',
'show_all',
);
});
$subSubMenu_checked->append($item_checked2);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'report_checked_2', $item_checked2);
my $item_checked = Gtk3::MenuItem->new('Checked _directions');
$item_checked->set_submenu($subSubMenu_checked);
$subMenu_reports->append($item_checked);
my $item_reports = Gtk3::MenuItem->new('_Generate reports');
$item_reports->set_submenu($subMenu_reports);
$column_edit->append($item_reports);
$column_edit->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Reset' sub-submenu
my $subMenu_reset = Gtk3::Menu->new();
my $item_resetRoomData = Gtk3::MenuItem->new('Reset _room data...');
$item_resetRoomData->signal_connect('activate' => sub {
$self->resetRoomDataCallback();
});
$subMenu_reset->append($item_resetRoomData);
my $item_resetCharVisits = Gtk3::MenuItem->new('Reset _visits by character...');
$item_resetCharVisits->signal_connect('activate' => sub {
$self->resetVisitsCallback();
});
$subMenu_reset->append($item_resetCharVisits);
my $item_reset = Gtk3::MenuItem->new('_Reset');
$item_reset->set_submenu($subMenu_reset);
$column_edit->append($item_reset);
$column_edit->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editDict = Gtk3::ImageMenuItem->new('Edit current _dictionary...');
my $img_editDict = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editDict->set_image($img_editDict);
$item_editDict->signal_connect('activate' => sub {
# Open an 'edit' window for the current dictionary
$self->createFreeWin(
'Games::Axmud::EditWin::Dict',
$self,
$self->session,
'Edit dictionary \'' . $self->session->currentDict->name . '\'',
$self->session->currentDict,
FALSE, # Not temporary
);
});
$column_edit->append($item_editDict);
my $item_addWords = Gtk3::MenuItem->new('Add dictionary _words...');
$item_addWords->signal_connect('activate' => sub {
$self->createFreeWin(
'Games::Axmud::OtherWin::QuickWord',
$self,
$self->session,
'Quick word adder',
);
});
$column_edit->append($item_addWords);
my $item_updateModel = Gtk3::MenuItem->new('U_pdate model words');
$item_updateModel->signal_connect('activate' => sub {
# Use pseudo-command mode 'win_error' - show success messages in the 'main' window,
# error messages in 'dialogue' window
$self->session->pseudoCmd('updatemodel -t', 'win_error');
});
$column_edit->append($item_updateModel);
$column_edit->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setupWizard = Gtk3::ImageMenuItem->new('Run _Locator wizard...');
my $img_setupWizard = Gtk3::Image->new_from_stock('gtk-page-setup', 'menu');
$item_setupWizard->set_image($img_setupWizard);
$item_setupWizard->signal_connect('activate' => sub {
if ($self->session->wizWin) {
# Some kind of 'wiz' window is already open
$self->session->wizWin->restoreFocus();
} else {
# Open the Locator wizard window
$self->session->pseudoCmd('locatorwizard', $self->pseudoCmdMode);
}
});
$column_edit->append($item_setupWizard);
my $item_editModel = Gtk3::ImageMenuItem->new('Edit world _model...');
my $img_editModel = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editModel->set_image($img_editModel);
$item_editModel->signal_connect('activate' => sub {
# Open an 'edit' window for the world model
$self->createFreeWin(
'Games::Axmud::EditWin::WorldModel',
$self,
$self->session,
'Edit world model',
$self->session->worldModelObj,
FALSE, # Not temporary
);
});
$column_edit->append($item_editModel);
# Setup complete
return $column_edit;
}
sub enableViewColumn {
# Sets up the 'View' column of the Automapper window's menu bar
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Local variables
my (
$item_group,
@magList, @shortMagList, @initList, @interiorList,
%interiorHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableViewColumn', @_);
}
# Set up column
my $column_view = Gtk3::Menu->new();
if (! $column_view) {
return undef;
}
# 'Window components' submenu
my $subMenu_winComponents = Gtk3::Menu->new();
my $item_showMenuBar = Gtk3::CheckMenuItem->new('Show menu_bar');
$item_showMenuBar->set_active($self->worldModelObj->showMenuBarFlag);
$item_showMenuBar->signal_connect('toggled' => sub {
$self->worldModelObj->toggleWinComponents(
'showMenuBarFlag',
$item_showMenuBar->get_active(),
);
});
$subMenu_winComponents->append($item_showMenuBar);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'show_menu_bar', $item_showMenuBar);
my $item_showToolbar = Gtk3::CheckMenuItem->new('Show _toolbar');
$item_showToolbar->set_active($self->worldModelObj->showToolbarFlag);
$item_showToolbar->signal_connect('toggled' => sub {
$self->worldModelObj->toggleWinComponents(
'showToolbarFlag',
$item_showToolbar->get_active(),
);
});
$subMenu_winComponents->append($item_showToolbar);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'show_toolbar', $item_showToolbar);
my $item_showTreeView = Gtk3::CheckMenuItem->new('Show _regions');
$item_showTreeView->set_active($self->worldModelObj->showTreeViewFlag);
$item_showTreeView->signal_connect('toggled' => sub {
$self->worldModelObj->toggleWinComponents(
'showTreeViewFlag',
$item_showTreeView->get_active(),
);
});
$subMenu_winComponents->append($item_showTreeView);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'show_treeview', $item_showTreeView);
my $item_showCanvas = Gtk3::CheckMenuItem->new('Show _map');
$item_showCanvas->set_active($self->worldModelObj->showCanvasFlag);
$item_showCanvas->signal_connect('toggled' => sub {
$self->worldModelObj->toggleWinComponents(
'showCanvasFlag',
$item_showCanvas->get_active(),
);
});
$subMenu_winComponents->append($item_showCanvas);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'show_canvas', $item_showCanvas);
$subMenu_winComponents->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_redrawWindow = Gtk3::MenuItem->new('Re_draw window');
$item_redrawWindow->signal_connect('activate' => sub {
$self->redrawWidgets('menu_bar', 'toolbar', 'treeview', 'canvas');
});
$subMenu_winComponents->append($item_redrawWindow);
my $item_windowComponents = Gtk3::MenuItem->new('_Window components');
$item_windowComponents->set_submenu($subMenu_winComponents);
$column_view->append($item_windowComponents);
# 'Current room' submenu
my $subMenu_currentRoom = Gtk3::Menu->new();
my $item_radio1 = Gtk3::RadioMenuItem->new_with_mnemonic(undef, 'Draw _normal room');
$item_radio1->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio1->get_active()) {
$self->worldModelObj->switchMode(
'currentRoomMode',
'single', # New value of ->currentRoomMode
FALSE, # No call to ->redrawRegions; current room is redrawn
'normal_current_mode',
);
}
});
my $item_group0 = $item_radio1->get_group();
$subMenu_currentRoom->append($item_radio1);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'normal_current_mode', $item_radio1);
my $item_radio2 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group0,
'Draw _emphasised room',
);
if ($self->worldModelObj->currentRoomMode eq 'double') {
$item_radio2->set_active(TRUE);
}
$item_radio2->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio2->get_active()) {
$self->worldModelObj->switchMode(
'currentRoomMode',
'double', # New value of ->currentRoomMode
FALSE, # No call to ->redrawRegions; current room is redrawn
'empahsise_current_room',
);
}
});
$subMenu_currentRoom->append($item_radio2);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'empahsise_current_room', $item_radio2);
my $item_radio3 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group0,
'Draw _filled-in room',
);
if ($self->worldModelObj->currentRoomMode eq 'interior') {
$item_radio3->set_active(TRUE);
}
$item_radio3->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio3->get_active()) {
$self->worldModelObj->switchMode(
'currentRoomMode',
'interior', # New value of ->currentRoomMode
FALSE, # No call to ->redrawRegions; current room is redrawn
'fill_in_current_room',
);
}
});
$subMenu_currentRoom->append($item_radio3);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'fill_in_current_room', $item_radio3);
my $item_currentRoom = Gtk3::MenuItem->new('_Draw current room');
$item_currentRoom->set_submenu($subMenu_currentRoom);
$column_view->append($item_currentRoom);
# 'Room filters' submenu
my $subMenu_roomFilters = Gtk3::Menu->new();
my $item_releaseAllFilters = Gtk3::CheckMenuItem->new('_Release all filters');
$item_releaseAllFilters->set_active($self->worldModelObj->allRoomFiltersFlag);
$item_releaseAllFilters->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'allRoomFiltersFlag',
$item_releaseAllFilters->get_active(),
TRUE, # Do call $self->redrawRegions
'release_all_filters',
'icon_release_all_filters',
);
}
});
$subMenu_roomFilters->append($item_releaseAllFilters);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'release_all_filters', $item_releaseAllFilters);
$subMenu_roomFilters->append(Gtk3::SeparatorMenuItem->new()); # Separator
my @shortcutList = $axmud::CLIENT->constRoomFilterKeyList;
foreach my $filter ($axmud::CLIENT->constRoomFilterList) {
my $shortcut = shift @shortcutList;
my $menuItem = Gtk3::CheckMenuItem->new('Release ' . $shortcut . ' filter');
$menuItem->set_active($self->worldModelObj->ivShow('roomFilterApplyHash', $filter));
$menuItem->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFilter(
$filter,
$menuItem->get_active(),
);
}
});
$subMenu_roomFilters->append($menuItem);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', $filter . '_filter', $menuItem);
}
my $item_roomFilters = Gtk3::MenuItem->new('Room _filters');
$item_roomFilters->set_submenu($subMenu_roomFilters);
$column_view->append($item_roomFilters);
# 'Room interiors' submenu
my $subMenu_roomInteriors = Gtk3::Menu->new();
@initList = (
'none' => '_Don\'t draw counts',
'shadow_count' => 'Draw _unallocated/shadow exits',
'region_count' => 'Draw re_gion/super region exits',
'checked_count' => 'Draw _checked/checkable directions',
'room_content' => 'Draw _room contents',
'hidden_count' => 'Draw _hidden contents',
'temp_count' => 'Draw _temporary contents',
'word_count' => 'Draw r_ecognised words',
'room_tag' => 'Draw room t_ag',
'room_flag' => 'Draw r_oom flag text',
'visit_count' => 'Draw character _visits',
'compare_count' => 'Draw _matching rooms',
'profile_count' => 'Draw e_xclusive profiles',
'title_descrip' => 'Draw t_itles/descriptions',
'exit_pattern' => 'Draw exit _patterns',
'source_code' => 'Draw room _source code',
'grid_posn' => 'Dra_w grid coordinates',
'vnum' => 'Draw world\'s room v_num',
);
do {
my ($mode, $descrip);
$mode = shift @initList;
$descrip = shift @initList;
push (@interiorList, $mode);
$interiorHash{$mode} = $descrip;
} until (! @initList);
for (my $count = 0; $count < (scalar @interiorList); $count++) {
my ($icon, $mode);
$mode = $interiorList[$count];
# (For $count = 0, $item_group is 'undef')
my $item_radio = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group,
$interiorHash{$mode},
);
if ($self->worldModelObj->roomInteriorMode eq $mode) {
$item_radio->set_active(TRUE);
}
$item_radio->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio->get_active()) {
$self->worldModelObj->switchRoomInteriorMode($mode);
}
});
$item_group = $item_radio->get_group();
$subMenu_roomInteriors->append($item_radio);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'interior_mode_' . $mode, $item_radio);
}
$subMenu_roomInteriors->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_changeCharDrawn = Gtk3::MenuItem->new('Ch_ange character drawn...');
$item_changeCharDrawn->signal_connect('activate' => sub {
# (Callback func has no dependencies)
$self->changeCharDrawnCallback();
});
$subMenu_roomInteriors->append($item_changeCharDrawn);
my $item_roomInteriors = Gtk3::MenuItem->new('R_oom interiors');
$item_roomInteriors->set_submenu($subMenu_roomInteriors);
$column_view->append($item_roomInteriors);
# 'All exits' submenu
my $subMenu_allExits = Gtk3::Menu->new();
my $item_radio11 = Gtk3::RadioMenuItem->new_with_mnemonic(
undef,
'_Use region exit settings',
);
$item_radio11->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio11->get_active()) {
$self->worldModelObj->switchMode(
'drawExitMode',
'ask_regionmap', # New value of ->drawExitMode
TRUE, # Do call $self->redrawRegions
'draw_defer_exits',
'icon_draw_defer_exits',
);
}
});
my $item_group1 = $item_radio11->get_group();
$subMenu_allExits->append($item_radio11);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_defer_exits', $item_radio11);
my $item_radio12 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group1,
'Draw _no exits',
);
if ($self->worldModelObj->drawExitMode eq 'no_exit') {
$item_radio12->set_active(TRUE);
}
$item_radio12->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio12->get_active()) {
$self->worldModelObj->switchMode(
'drawExitMode',
'no_exit', # New value of ->drawExitMode
TRUE, # Do call $self->redrawRegions
'draw_no_exits',
'icon_draw_no_exits',
);
}
});
$subMenu_allExits->append($item_radio12);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_no_exits', $item_radio12);
my $item_radio13 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group1,
'Draw _simple exits',
);
if ($self->worldModelObj->drawExitMode eq 'simple_exit') {
$item_radio13->set_active(TRUE);
}
$item_radio13->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio13->get_active()) {
$self->worldModelObj->switchMode(
'drawExitMode',
'simple_exit', # New value of ->drawExitMode
TRUE, # Do call $self->redrawRegions
'draw_simple_exits',
'icon_draw_simple_exits',
);
}
});
$subMenu_allExits->append($item_radio13);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_simple_exits', $item_radio13);
my $item_radio14 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group1,
'Draw _complex exits',
);
if ($self->worldModelObj->drawExitMode eq 'complex_exit') {
$item_radio14->set_active(TRUE);
}
$item_radio14->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio14->get_active()) {
$self->worldModelObj->switchMode(
'drawExitMode',
'complex_exit', # New value of ->drawExitMode
TRUE, # Do call $self->redrawRegions
'draw_complex_exits',
'icon_draw_complex_exits',
);
}
});
$subMenu_allExits->append($item_radio14);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_complex_exits', $item_radio14);
$subMenu_allExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_obscuredExits = Gtk3::CheckMenuItem->new('_Obscure unimportant exits');
$item_obscuredExits->set_active($self->worldModelObj->obscuredExitFlag);
$item_obscuredExits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'obscuredExitFlag',
$item_obscuredExits->get_active(),
TRUE, # Do call $self->redrawRegions
'obscured_exits',
'icon_obscured_exits',
);
}
});
$subMenu_allExits->append($item_obscuredExits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'obscured_exits', $item_obscuredExits);
my $item_autoRedraw = Gtk3::CheckMenuItem->new('_Auto-redraw obscured exits');
$item_autoRedraw->set_active($self->worldModelObj->obscuredExitRedrawFlag);
$item_autoRedraw->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'obscuredExitRedrawFlag',
$item_autoRedraw->get_active(),
TRUE, # Do call $self->redrawRegions
'auto_redraw_obscured',
'icon_auto_redraw_obscured',
);
}
});
$subMenu_allExits->append($item_autoRedraw);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_redraw_obscured', $item_autoRedraw);
my $item_obscuredExitRadius = Gtk3::MenuItem->new('Set obscure _radius...');
$item_obscuredExitRadius->signal_connect('activate' => sub {
$self->obscuredRadiusCallback();
});
$subMenu_allExits->append($item_obscuredExitRadius);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'obscured_exit_radius', $item_obscuredExitRadius);
$subMenu_allExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_drawOrnaments = Gtk3::CheckMenuItem->new('Draw exit orna_ments');
$item_drawOrnaments->set_active($self->worldModelObj->drawOrnamentsFlag);
$item_drawOrnaments->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'drawOrnamentsFlag',
$item_drawOrnaments->get_active(),
TRUE, # Do call $self->redrawRegions
'draw_ornaments',
'icon_draw_ornaments',
);
}
});
$subMenu_allExits->append($item_drawOrnaments);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_ornaments', $item_drawOrnaments);
my $item_allExits = Gtk3::MenuItem->new('Exits (_all regions)');
$item_allExits->set_submenu($subMenu_allExits);
$column_view->append($item_allExits);
# 'Region exits' submenu
my $subMenu_regionExits = Gtk3::Menu->new();
my $item_radio21 = Gtk3::RadioMenuItem->new_with_mnemonic(undef, 'Draw _no exits');
$item_radio21->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio21->get_active()) {
$self->worldModelObj->switchRegionDrawExitMode(
$self->currentRegionmap,
'no_exit',
);
}
});
my $item_group2 = $item_radio21->get_group();
$subMenu_regionExits->append($item_radio21);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'region_draw_no_exits', $item_radio21);
my $item_radio22 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group2,
'Draw _simple exits',
);
if ($self->currentRegionmap && $self->currentRegionmap->drawExitMode eq 'simple_exit') {
$item_radio22->set_active(TRUE);
}
$item_radio22->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio22->get_active()) {
$self->worldModelObj->switchRegionDrawExitMode(
$self->currentRegionmap,
'simple_exit',
);
}
});
$subMenu_regionExits->append($item_radio22);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'region_draw_simple_exits', $item_radio22);
my $item_radio23 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group2,
'Draw _complex exits',
);
if (
$self->currentRegionmap
&& $self->currentRegionmap->drawExitMode eq 'complex_exit'
) {
$item_radio23->set_active(TRUE);
}
$item_radio23->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio23->get_active()) {
$self->worldModelObj->switchRegionDrawExitMode(
$self->currentRegionmap,
'complex_exit',
);
}
});
$subMenu_regionExits->append($item_radio23);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'region_draw_complex_exits', $item_radio23);
$subMenu_regionExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_obscuredExitsRegion = Gtk3::CheckMenuItem->new('_Obscure unimportant exits');
if ($self->currentRegionmap) {
$item_obscuredExitsRegion->set_active($self->currentRegionmap->obscuredExitFlag);
}
$item_obscuredExitsRegion->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleObscuredExitFlag($self->currentRegionmap);
}
});
$subMenu_regionExits->append($item_obscuredExitsRegion);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'obscured_exits_region', $item_obscuredExitsRegion);
my $item_autoRedrawRegion = Gtk3::CheckMenuItem->new('_Auto-redraw obscured exits');
if ($self->currentRegionmap) {
$item_autoRedrawRegion->set_active($self->currentRegionmap->obscuredExitRedrawFlag);
}
$item_autoRedrawRegion->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleObscuredExitRedrawFlag($self->currentRegionmap);
}
});
$subMenu_regionExits->append($item_autoRedrawRegion);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_redraw_obscured_region', $item_autoRedrawRegion);
my $item_obscuredExitRadiusRegion = Gtk3::MenuItem->new('Set obscure _radius...');
$item_obscuredExitRadiusRegion->signal_connect('activate' => sub {
$self->obscuredRadiusCallback($self->currentRegionmap);
});
$subMenu_regionExits->append($item_obscuredExitRadiusRegion);
# (Never desensitised)
$self->ivAdd(
'menuToolItemHash',
'obscured_exit_radius_region',
$item_obscuredExitRadiusRegion,
);
$subMenu_regionExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_drawOrnamentsRegion = Gtk3::CheckMenuItem->new('Draw exit orna_ments');
if ($self->currentRegionmap) {
$item_drawOrnamentsRegion->set_active($self->currentRegionmap->drawOrnamentsFlag);
}
$item_drawOrnamentsRegion->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleDrawOrnamentsFlag($self->currentRegionmap);
}
});
$subMenu_regionExits->append($item_drawOrnamentsRegion);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_ornaments_region', $item_drawOrnamentsRegion);
my $item_regionExits = Gtk3::MenuItem->new('Exits (_current region)');
$item_regionExits->set_submenu($subMenu_regionExits);
$column_view->append($item_regionExits);
# (Requires $self->currentRegionmap and $self->worldModelObj->drawExitMode is
# 'ask_regionmap')
$self->ivAdd('menuToolItemHash', 'draw_region_exits', $item_regionExits);
$column_view->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_zoomIn = Gtk3::ImageMenuItem->new('Zoom i_n');
my $img_zoomIn = Gtk3::Image->new_from_stock('gtk-zoom-in', 'menu');
$item_zoomIn->set_image($img_zoomIn);
$item_zoomIn->signal_connect('activate' => sub {
$self->zoomCallback('in');
});
$column_view->append($item_zoomIn);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'zoom_in', $item_zoomIn);
my $item_zoomOut = Gtk3::ImageMenuItem->new('Zoom _out');
my $img_zoomOut = Gtk3::Image->new_from_stock('gtk-zoom-out', 'menu');
$item_zoomOut->set_image($img_zoomOut);
$item_zoomOut->signal_connect('activate' => sub {
$self->zoomCallback('out');
});
$column_view->append($item_zoomOut);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'zoom_out', $item_zoomOut);
# 'Zoom' submenu
my $subMenu_zoom = Gtk3::Menu->new();
# Import the list of magnifications
@magList = $self->constMagnifyList;
# Use a subset of magnifications from $self->constMagnifyList (and in reverse order to
# that found in $self->constMagnifyList)
@shortMagList = reverse $self->constShortMagnifyList;
foreach my $mag (@shortMagList) {
my $menuItem = Gtk3::MenuItem->new('Zoom ' . $mag * 100 . '%');
$menuItem->signal_connect('activate' => sub {
# No argument causes the called function to prompt the user
$self->zoomCallback($mag);
});
$subMenu_zoom->append($menuItem);
}
$subMenu_zoom->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_zoomMax = Gtk3::MenuItem->new('Zoom _in max');
$item_zoomMax->signal_connect('activate' => sub {
$self->zoomCallback($magList[-1]);
});
$subMenu_zoom->append($item_zoomMax);
my $item_zoomMin = Gtk3::MenuItem->new('Zoom _out max');
$item_zoomMin->signal_connect('activate' => sub {
$self->zoomCallback($magList[0]);
});
$subMenu_zoom->append($item_zoomMin);
$subMenu_zoom->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_zoomPrompt = Gtk3::MenuItem->new('O_ther...');
$item_zoomPrompt->signal_connect('activate' => sub {
# No argument causes the called function to prompt the user
$self->zoomCallback();
});
$subMenu_zoom->append($item_zoomPrompt);
my $item_zoom = Gtk3::ImageMenuItem->new('_Zoom');
my $img_zoom = Gtk3::Image->new_from_stock('gtk-zoom-fit', 'menu');
$item_zoom->set_image($img_zoom);
$item_zoom->set_submenu($subMenu_zoom);
$column_view->append($item_zoom);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'zoom_sub', $item_zoom);
$column_view->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Level' submenu
my $subMenu_level = Gtk3::Menu->new();
my $item_moveUpLevel = Gtk3::MenuItem->new('Move _up level');
$item_moveUpLevel->signal_connect('activate' => sub {
$self->setCurrentLevel($self->currentRegionmap->currentLevel + 1);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
});
$subMenu_level->append($item_moveUpLevel);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'move_up_level', $item_moveUpLevel);
my $item_moveDownLevel = Gtk3::MenuItem->new('Move _down level');
$item_moveDownLevel->signal_connect('activate' => sub {
$self->setCurrentLevel($self->currentRegionmap->currentLevel - 1);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
});
$subMenu_level->append($item_moveDownLevel);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'move_down_level', $item_moveDownLevel);
$subMenu_level->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_changeLevel = Gtk3::MenuItem->new('_Change level...');
$item_changeLevel->signal_connect('activate' => sub {
$self->changeLevelCallback();
});
$subMenu_level->append($item_changeLevel);
my $item_level = Gtk3::MenuItem->new('_Level');
$item_level->set_submenu($subMenu_level);
$column_view->append($item_level);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'level_sub', $item_level);
$column_view->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Centre map' submenu
my $subMenu_centreMap = Gtk3::Menu->new();
my $item_centreMap_currentRoom = Gtk3::MenuItem->new('_Current room');
$item_centreMap_currentRoom->signal_connect('activate' => sub {
$self->centreMapOverRoom($self->mapObj->currentRoom);
});
$subMenu_centreMap->append($item_centreMap_currentRoom);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd(
'menuToolItemHash',
'centre_map_current_room',
$item_centreMap_currentRoom,
);
my $item_centreMap_selectRoom = Gtk3::MenuItem->new('_Selected room');
$item_centreMap_selectRoom->signal_connect('activate' => sub {
$self->centreMapOverRoom($self->selectedRoom);
});
$subMenu_centreMap->append($item_centreMap_selectRoom);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd(
'menuToolItemHash',
'centre_map_select_room',
$item_centreMap_selectRoom,
);
my $item_centreMap_lastKnownRoom = Gtk3::MenuItem->new('_Last known room');
$item_centreMap_lastKnownRoom->signal_connect('activate' => sub {
$self->centreMapOverRoom($self->mapObj->lastKnownRoom);
});
$subMenu_centreMap->append($item_centreMap_lastKnownRoom);
# (Requires $self->currentRegionmap & $self->mapObj->lastknownRoom)
$self->ivAdd(
'menuToolItemHash',
'centre_map_last_known_room',
$item_centreMap_lastKnownRoom,
);
$subMenu_centreMap->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_centreMap_middleGrid = Gtk3::MenuItem->new('_Middle of grid');
$item_centreMap_middleGrid->signal_connect('activate' => sub {
$self->setMapPosn(0.5, 0.5);
});
$subMenu_centreMap->append($item_centreMap_middleGrid);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'centre_map_middle_grid', $item_centreMap_middleGrid);
my $item_centreMap = Gtk3::MenuItem->new('Centre _map');
$item_centreMap->set_submenu($subMenu_centreMap);
$column_view->append($item_centreMap);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'centre_map_sub', $item_centreMap);
my $item_repositionAllMaps = Gtk3::MenuItem->new('_Reposition all maps');
$item_repositionAllMaps->signal_connect('activate' => sub {
$self->worldModelObj->repositionMaps();
});
$column_view->append($item_repositionAllMaps);
# 'Tracking' submenu
my $subMenu_tracking = Gtk3::Menu->new();
my $item_trackCurrentRoom = Gtk3::CheckMenuItem->new('_Track current room');
$item_trackCurrentRoom->set_active($self->worldModelObj->trackPosnFlag);
$item_trackCurrentRoom->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'trackPosnFlag',
$item_trackCurrentRoom->get_active(),
FALSE, # Don't call $self->redrawRegions
'track_current_room',
'icon_track_current_room',
);
}
});
$subMenu_tracking->append($item_trackCurrentRoom);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'track_current_room', $item_trackCurrentRoom);
$subMenu_tracking->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_radio31 = Gtk3::RadioMenuItem->new_with_mnemonic(undef, '_Always track');
if (
$self->worldModelObj->trackingSensitivity != 0.33
&& $self->worldModelObj->trackingSensitivity != 0.66
&& $self->worldModelObj->trackingSensitivity != 1
) {
# Only the sensitivity values 0, 0.33, 0.66 and 1 are curently allowed; act as
# though the IV was set to 0
$item_radio31->set_active(TRUE);
}
$item_radio31->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio31->get_active()) {
$self->worldModelObj->setTrackingSensitivity(0);
}
});
my $item_group3 = $item_radio31->get_group();
$subMenu_tracking->append($item_radio31);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'track_always', $item_radio31);
my $item_radio32 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group3,
'Track near _centre',
);
if ($self->worldModelObj->trackingSensitivity == 0.33) {
$item_radio32->set_active(TRUE);
}
$item_radio32->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio32->get_active()) {
$self->worldModelObj->setTrackingSensitivity(0.33);
}
});
$subMenu_tracking->append($item_radio32);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'track_near_centre', $item_radio32);
my $item_radio33 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group3,
'Track near _edge',
);
if ($self->worldModelObj->trackingSensitivity == 0.66) {
$item_radio33->set_active(TRUE);
}
$item_radio33->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio33->get_active()) {
$self->worldModelObj->setTrackingSensitivity(0.66);
}
});
$subMenu_tracking->append($item_radio33);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'track_near_edge', $item_radio33);
my $item_radio34 = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_group3,
'Track if not _visible',
);
if ($self->worldModelObj->trackingSensitivity == 1) {
$item_radio34->set_active(TRUE);
}
$item_radio34->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $item_radio34->get_active()) {
$self->worldModelObj->setTrackingSensitivity(1);
}
});
$subMenu_tracking->append($item_radio34);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'track_not_visible', $item_radio34);
my $item_tracking = Gtk3::MenuItem->new('_Tracking');
$item_tracking->set_submenu($subMenu_tracking);
$column_view->append($item_tracking);
# Setup complete
return $column_view;
}
sub enableModeColumn {
# Called by $self->enableMenu
# Sets up the 'Mode' column of the Automapper window's menu bar
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableModeColumn', @_);
}
# Set up column
my $column_mode = Gtk3::Menu->new();
if (! $column_mode) {
return undef;
}
# (Save each radio menu item in a hash IV, so that when $self->setMode is called, the radio
# group can be toggled)
my $item_radio1 = Gtk3::RadioMenuItem->new_with_mnemonic(undef, '_Wait mode');
$item_radio1->signal_connect('toggled' => sub {
# (To stop the equivalent toolbar icon from being toggled by the call to ->setMode,
# make use of $self->ignoreMenuUpdateFlag)
if ($item_radio1->get_active && ! $self->ignoreMenuUpdateFlag) {
$self->setMode('wait');
}
});
my $item_group = $item_radio1->get_group();
$column_mode->append($item_radio1);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'set_wait_mode', $item_radio1);
my $item_radio2 = Gtk3::RadioMenuItem->new_with_mnemonic($item_group, '_Follow mode');
$item_radio2->signal_connect('toggled' => sub {
if ($item_radio2->get_active && ! $self->ignoreMenuUpdateFlag) {
$self->setMode('follow');
}
});
$column_mode->append($item_radio2);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'set_follow_mode', $item_radio2);
my $item_radio3 = Gtk3::RadioMenuItem->new_with_mnemonic($item_group, '_Update mode');
$item_radio3->signal_connect('toggled' => sub {
if ($item_radio3->get_active && ! $self->ignoreMenuUpdateFlag) {
$self->setMode('update');
}
});
$column_mode->append($item_radio3);
# (Requires $self->currentRegionmap, GA::Obj::WorldModel->disableUpdateModeFlag set to
# FALSE and a session not in 'connect offline' mode
$self->ivAdd('menuToolItemHash', 'set_update_mode', $item_radio3);
$column_mode->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_dragMode = Gtk3::CheckMenuItem->new('_Drag mode');
$item_dragMode->set_active($self->dragModeFlag);
$item_dragMode->signal_connect('toggled' => sub {
if ($item_dragMode->get_active()) {
$self->ivPoke('dragModeFlag', TRUE);
} else {
$self->ivPoke('dragModeFlag', FALSE);
}
# Set the equivalent toolbar button
if ($self->ivExists('menuToolItemHash', 'icon_drag_mode')) {
my $menuItem = $self->ivShow('menuToolItemHash', 'icon_drag_mode');
$menuItem->set_active($item_dragMode->get_active());
}
});
$column_mode->append($item_dragMode);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'drag_mode', $item_dragMode);
my $item_graffitMode = Gtk3::CheckMenuItem->new('_Graffiti mode');
$item_graffitMode->set_active($self->graffitiModeFlag);
$item_graffitMode->signal_connect('toggled' => sub {
my @redrawList;
if ($item_graffitMode->get_active()) {
$self->ivPoke('graffitiModeFlag', TRUE);
# Tag current room, if any
if ($self->mapObj->currentRoom) {
$self->ivAdd('graffitiHash', $self->mapObj->currentRoom->number);
$self->markObjs('room', $self->mapObj->currentRoom);
$self->doDraw();
}
# Initialise graffitied room counts
$self->setWinTitle();
} else {
$self->ivPoke('graffitiModeFlag', FALSE);
foreach my $num ($self->ivKeys('graffitiHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $num);
if ($roomObj) {
push (@redrawList, 'room', $self->worldModelObj->ivShow('modelHash', $num));
}
}
$self->ivEmpty('graffitiHash');
# Redraw any graffitied rooms
if (@redrawList) {
$self->markObjs(@redrawList);
$self->doDraw();
}
# Remove graffitied room counts
$self->setWinTitle();
}
# Set the equivalent toolbar button
if ($self->ivExists('menuToolItemHash', 'icon_graffiti_mode')) {
my $menuItem = $self->ivShow('menuToolItemHash', 'icon_graffiti_mode');
$menuItem->set_active($item_graffitMode->get_active());
}
# The menu items which toggle graffiti in selected rooms are desensitised if
# ->graffitiModeFlag is FALSE
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
});
$column_mode->append($item_graffitMode);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'graffiti_mode', $item_graffitMode);
$column_mode->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Match rooms' submenu
my $subMenu_matchRooms = Gtk3::Menu->new();
my $item_matchTitle = Gtk3::CheckMenuItem->new('Match room _titles');
$item_matchTitle->set_active($self->worldModelObj->matchTitleFlag);
$item_matchTitle->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'matchTitleFlag',
$item_matchTitle->get_active(),
FALSE, # Do call $self->redrawRegions
'match_title',
);
}
});
$subMenu_matchRooms->append($item_matchTitle);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'match_title', $item_matchTitle);
my $item_matchDescrip = Gtk3::CheckMenuItem->new('Match room _descriptions');
$item_matchDescrip->set_active($self->worldModelObj->matchDescripFlag);
$item_matchDescrip->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'matchDescripFlag',
$item_matchDescrip->get_active(),
FALSE, # Do call $self->redrawRegions
'match_descrip',
);
}
});
$subMenu_matchRooms->append($item_matchDescrip);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'match_descrip', $item_matchDescrip);
my $item_matchExit = Gtk3::CheckMenuItem->new('Match _exits');
$item_matchExit->set_active($self->worldModelObj->matchExitFlag);
$item_matchExit->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'matchExitFlag',
$item_matchExit->get_active(),
FALSE, # Do call $self->redrawRegions
'match_exit',
);
}
});
$subMenu_matchRooms->append($item_matchExit);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'match_exit', $item_matchExit);
my $item_matchSource = Gtk3::CheckMenuItem->new('Match _source code');
$item_matchSource->set_active($self->worldModelObj->matchSourceFlag);
$item_matchSource->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'matchSourceFlag',
$item_matchSource->get_active(),
FALSE, # Do call $self->redrawRegions
'match_source',
);
}
});
$subMenu_matchRooms->append($item_matchSource);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'match_source', $item_matchSource);
my $item_matchVNum = Gtk3::CheckMenuItem->new('Match room _vnum');
$item_matchVNum->set_active($self->worldModelObj->matchVNumFlag);
$item_matchVNum->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'matchVNumFlag',
$item_matchVNum->get_active(),
FALSE, # Do call $self->redrawRegions
'match_vnum',
);
}
});
$subMenu_matchRooms->append($item_matchVNum);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'match_vnum', $item_matchVNum);
$subMenu_matchRooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_verboseChars = Gtk3::MenuItem->new('Set description _length...');
$item_verboseChars->signal_connect('activate' => sub {
$self->verboseCharsCallback();
});
$subMenu_matchRooms->append($item_verboseChars);
my $item_matchRooms = Gtk3::MenuItem->new('_Match rooms');
$item_matchRooms->set_submenu($subMenu_matchRooms);
$column_mode->append($item_matchRooms);
# 'Update rooms' submenu
my $subMenu_updateRooms = Gtk3::Menu->new();
my $item_updateTitle = Gtk3::CheckMenuItem->new('Update room _titles');
$item_updateTitle->set_active($self->worldModelObj->updateTitleFlag);
$item_updateTitle->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'updateTitleFlag',
$item_updateTitle->get_active(),
FALSE, # Do call $self->redrawRegions
'update_title',
);
}
});
$subMenu_updateRooms->append($item_updateTitle);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'update_title', $item_updateTitle);
my $item_updateDescrip = Gtk3::CheckMenuItem->new('Update room _descriptions');
$item_updateDescrip->set_active($self->worldModelObj->updateDescripFlag);
$item_updateDescrip->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'updateDescripFlag',
$item_updateDescrip->get_active(),
FALSE, # Do call $self->redrawRegions
'update_descrip',
);
}
});
$subMenu_updateRooms->append($item_updateDescrip);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'update_descrip', $item_updateDescrip);
my $item_updateExit = Gtk3::CheckMenuItem->new('Update _exits');
$item_updateExit->set_active($self->worldModelObj->updateExitFlag);
$item_updateExit->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'updateExitFlag',
$item_updateExit->get_active(),
FALSE, # Do call $self->redrawRegions
'update_exit',
);
}
});
$subMenu_updateRooms->append($item_updateExit);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'update_exit', $item_updateExit);
my $item_updateOrnament
= Gtk3::CheckMenuItem->new('Update _ornaments from exit state');
$item_updateOrnament->set_active($self->worldModelObj->updateOrnamentFlag);
$item_updateOrnament->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'updateOrnamentFlag',
$item_updateOrnament->get_active(),
FALSE, # Do call $self->redrawRegions
'update_ornament',
);
}
});
$subMenu_updateRooms->append($item_updateOrnament);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'update_ornament', $item_updateOrnament);
my $item_updateSource = Gtk3::CheckMenuItem->new('Update _source code');
$item_updateSource->set_active($self->worldModelObj->updateSourceFlag);
$item_updateSource->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'updateSourceFlag',
$item_updateSource->get_active(),
FALSE, # Do call $self->redrawRegions
'update_source',
);
}
});
$subMenu_updateRooms->append($item_updateSource);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'update_source', $item_updateSource);
my $item_updateVNum = Gtk3::CheckMenuItem->new('Update room _vnum, etc');
$item_updateVNum->set_active($self->worldModelObj->updateVNumFlag);
$item_updateVNum->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'updateVNumFlag',
$item_updateVNum->get_active(),
FALSE, # Do call $self->redrawRegions
'update_vnum',
);
}
});
$subMenu_updateRooms->append($item_updateVNum);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'update_vnum', $item_updateVNum);
my $item_updateRoomCmd = Gtk3::CheckMenuItem->new('Update room _commands');
$item_updateRoomCmd->set_active($self->worldModelObj->updateRoomCmdFlag);
$item_updateRoomCmd->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'updateRoomCmdFlag',
$item_updateRoomCmd->get_active(),
FALSE, # Do call $self->redrawRegions
'update_room_cmd',
);
}
});
$subMenu_updateRooms->append($item_updateRoomCmd);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'update_room_cmd', $item_updateRoomCmd);
$subMenu_updateRooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_analyseDescrip = Gtk3::CheckMenuItem->new('_Analyse room descrips');
$item_analyseDescrip->set_active($self->worldModelObj->analyseDescripFlag);
$item_analyseDescrip->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'analyseDescripFlag',
$item_analyseDescrip->get_active(),
FALSE, # Don't call $self->redrawRegions
'analyse_descrip',
);
}
});
$subMenu_updateRooms->append($item_analyseDescrip);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'analyse_descrip', $item_analyseDescrip);
my $item_updateRooms = Gtk3::MenuItem->new('Update _rooms');
$item_updateRooms->set_submenu($subMenu_updateRooms);
$column_mode->append($item_updateRooms);
$column_mode->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Painter' submenu
my $subMenu_painter = Gtk3::Menu->new();
my $item_painterEnabled = Gtk3::CheckMenuItem->new('_Painter enabled');
$item_painterEnabled->set_active($self->painterFlag);
$item_painterEnabled->signal_connect('toggled' => sub {
my $item;
# Toggle the flag
if ($item_painterEnabled->get_active()) {
$self->ivPoke('painterFlag', TRUE);
} else {
$self->ivPoke('painterFlag', FALSE);
}
# Update the corresponding toolbar icon
$item = $self->ivShow('menuToolItemHash', 'icon_enable_painter');
if ($item) {
$item->set_active($self->painterFlag);
}
});
$subMenu_painter->append($item_painterEnabled);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'enable_painter', $item_painterEnabled);
$subMenu_painter->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_paintAll = Gtk3::RadioMenuItem->new_with_mnemonic(undef, 'Paint _all rooms');
$item_paintAll->signal_connect('toggled' => sub {
if ($item_paintAll->get_active) {
$self->worldModelObj->set_paintAllRoomsFlag(TRUE);
# Set the equivalent toolbar button
if ($self->ivExists('menuToolItemHash', 'icon_paint_all')) {
$self->ivShow('menuToolItemHash', 'icon_paint_all')->set_active(TRUE);
}
}
});
my $item_paintGroup = $item_paintAll->get_group();
$subMenu_painter->append($item_paintAll);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'paint_all', $item_paintAll);
my $item_paintNew = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_paintGroup,
'Paint _only new rooms',
);
if (! $self->worldModelObj->paintAllRoomsFlag) {
$item_paintNew->set_active(TRUE);
}
$item_paintNew->signal_connect('toggled' => sub {
if ($item_paintNew->get_active) {
$self->worldModelObj->set_paintAllRoomsFlag(FALSE);
# Set the equivalent toolbar button
if ($self->ivExists('menuToolItemHash', 'icon_paint_new')) {
$self->ivShow('menuToolItemHash', 'icon_paint_new')->set_active(TRUE);
}
}
});
$subMenu_painter->append($item_paintNew);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'paint_new', $item_paintNew);
$subMenu_painter->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_paintNormal = Gtk3::RadioMenuItem->new_with_mnemonic(
undef,
'Paint _normal rooms',
);
$item_paintNormal->signal_connect('toggled' => sub {
if ($item_paintNormal->get_active) {
$self->worldModelObj->painterObj->ivPoke('wildMode', 'normal');
# Set the equivalent toolbar button
if ($self->ivExists('menuToolItemHash', 'icon_paint_normal')) {
$self->ivShow('menuToolItemHash', 'icon_paint_normal')->set_active(TRUE);
}
}
});
my $item_paintGroup2 = $item_paintNormal->get_group();
$subMenu_painter->append($item_paintNormal);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'paint_normal', $item_paintNormal);
my $item_paintWild = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_paintGroup2,
'Paint _wilderness rooms',
);
if ($self->worldModelObj->painterObj->wildMode eq 'wild') {
$item_paintWild->set_active(TRUE);
}
$item_paintWild->signal_connect('toggled' => sub {
if ($item_paintWild->get_active) {
$self->worldModelObj->painterObj->ivPoke('wildMode', 'wild');
# Set the equivalent toolbar button
if ($self->ivExists('menuToolItemHash', 'icon_paint_wild')) {
$self->ivShow('menuToolItemHash', 'icon_paint_wild')->set_active(TRUE);
}
}
});
$subMenu_painter->append($item_paintWild);
# (Requires $self->session->currentWorld->basicMappingFlag to be FALSE)
$self->ivAdd('menuToolItemHash', 'paint_wild', $item_paintWild);
my $item_paintBorder = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_paintGroup2,
'Paint wilderness _border rooms',
);
if ($self->worldModelObj->painterObj->wildMode eq 'border') {
$item_paintBorder->set_active(TRUE);
}
$item_paintBorder->signal_connect('toggled' => sub {
if ($item_paintBorder->get_active) {
$self->worldModelObj->painterObj->ivPoke('wildMode', 'border');
# Set the equivalent toolbar button
if ($self->ivExists('menuToolItemHash', 'icon_paint_border')) {
$self->ivShow('menuToolItemHash', 'icon_paint_border')->set_active(TRUE);
}
}
});
$subMenu_painter->append($item_paintBorder);
# (Requires $self->session->currentWorld->basicMappingFlag to be FALSE)
$self->ivAdd('menuToolItemHash', 'paint_border', $item_paintBorder);
$subMenu_painter->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_repaintCurrentRoom = Gtk3::MenuItem->new('Repaint _current room');
$item_repaintCurrentRoom->signal_connect('activate' => sub {
if ($self->mapObj->currentRoom) {
# Repaint the current room. The TRUE argument instructs the function to tell
# the world model to redraw the room in every Automapper window
$self->paintRoom($self->mapObj->currentRoom, TRUE);
}
});
$subMenu_painter->append($item_repaintCurrentRoom);
# (Requires $self->currentRegionmap and $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'repaint_current', $item_repaintCurrentRoom);
my $item_repaintSelectedRooms = Gtk3::MenuItem->new('Repaint _selected rooms');
$item_repaintSelectedRooms->signal_connect('activate' => sub {
$self->repaintSelectedRoomsCallback();
});
$subMenu_painter->append($item_repaintSelectedRooms);
# (Requires $self->currentRegionmap and either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'repaint_selected', $item_repaintSelectedRooms);
$subMenu_painter->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editPainter = Gtk3::ImageMenuItem->new('_Edit painter...');
my $img_editPainter = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editPainter->set_image($img_editPainter);
$item_editPainter->signal_connect('activate' => sub {
# Open an 'edit' window for the painter object
$self->createFreeWin(
'Games::Axmud::EditWin::Painter',
$self,
$self->session,
'Edit world model painter',
$self->worldModelObj->painterObj,
FALSE, # Not temporary
);
});
$subMenu_painter->append($item_editPainter);
$subMenu_painter->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_resetPainter = Gtk3::MenuItem->new('_Reset painter');
$item_resetPainter->signal_connect('activate' => sub {
$self->worldModelObj->resetPainter($self->session);
$self->showMsgDialogue(
'Painter',
'info',
'The painter object has been reset',
'ok',
);
});
$subMenu_painter->append($item_resetPainter);
my $item_painter = Gtk3::ImageMenuItem->new('_Painter');
my $img_painter = Gtk3::Image->new_from_stock('gtk-select-color', 'menu');
$item_painter->set_image($img_painter);
$item_painter->set_submenu($subMenu_painter);
$column_mode->append($item_painter);
$column_mode->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Auto-compare' submenu
my $subMenu_autoCompare = Gtk3::Menu->new();
my $item_compareDefault = Gtk3::RadioMenuItem->new_with_mnemonic(
undef,
'_Don\'t auto-compare current room',
);
$item_compareDefault->signal_connect('toggled' => sub {
if ($item_compareDefault->get_active) {
$self->worldModelObj->setAutoCompareMode('default');
}
});
my $item_compareGroup = $item_compareDefault->get_group();
$subMenu_autoCompare->append($item_compareDefault);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_compare_default', $item_compareDefault);
my $item_compareNew = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_compareGroup,
'Auto-compare _new rooms',
);
if ($self->worldModelObj->autoCompareMode eq 'new') {
$item_compareNew->set_active(TRUE);
}
$item_compareNew->signal_connect('toggled' => sub {
if ($item_compareNew->get_active) {
$self->worldModelObj->setAutoCompareMode('new');
}
});
$subMenu_autoCompare->append($item_compareNew);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_compare_new', $item_compareNew);
my $item_compareCurrent = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_compareGroup,
'Auto-compare the _current room',
);
if ($self->worldModelObj->autoCompareMode eq 'current') {
$item_compareCurrent->set_active(TRUE);
}
$item_compareCurrent->signal_connect('toggled' => sub {
if ($item_compareCurrent->get_active) {
$self->worldModelObj->setAutoCompareMode('current');
}
});
$subMenu_autoCompare->append($item_compareCurrent);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_compare_current', $item_compareCurrent);
$subMenu_autoCompare->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_compareRegion = Gtk3::RadioMenuItem->new_with_mnemonic(
undef,
'Compare with rooms in _same region',
);
$item_compareRegion->signal_connect('toggled' => sub {
if ($item_compareRegion->get_active) {
$self->worldModelObj->toggleAutoCompareAllFlag(FALSE);
}
});
my $item_compareRegionGroup = $item_compareRegion->get_group();
$subMenu_autoCompare->append($item_compareRegion);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_compare_region', $item_compareRegion);
my $item_compareWhole = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_compareRegionGroup,
'Compare with rooms in _whole world',
);
if ($self->worldModelObj->autoCompareAllFlag) {
$item_compareWhole->set_active(TRUE);
}
$item_compareWhole->signal_connect('toggled' => sub {
if ($item_compareWhole->get_active) {
$self->worldModelObj->toggleAutoCompareAllFlag(TRUE);
}
});
$subMenu_autoCompare->append($item_compareWhole);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_compare_model', $item_compareWhole);
$subMenu_autoCompare->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_compareMax = Gtk3::MenuItem->new('Set _limit on room comparisons...');
$item_compareMax->signal_connect('activate' => sub {
$self->autoCompareMaxCallback();
});
$subMenu_autoCompare->append($item_compareMax);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_compare_max', $item_compareMax);
my $item_autoCompare = Gtk3::MenuItem->new('_Auto-compare');
$item_autoCompare->set_submenu($subMenu_autoCompare);
$column_mode->append($item_autoCompare);
# 'Auto-rescue mode' submenu
my $subMenu_autoRescue = Gtk3::Menu->new();
my $item_autoRescueEnable = Gtk3::CheckMenuItem->new('_Enable auto-rescue mode');
$item_autoRescueEnable->set_active($self->worldModelObj->autoRescueFlag);
$item_autoRescueEnable->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'autoRescueFlag',
$item_autoRescueEnable->get_active(),
FALSE, # Don't call $self->redrawRegions
'auto_rescue',
);
}
});
$subMenu_autoRescue->append($item_autoRescueEnable);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_rescue', $item_autoRescueEnable);
$subMenu_autoRescue->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_autoRescueFirst = Gtk3::CheckMenuItem->new(
'_Merge at first matching room',
);
$item_autoRescueFirst->set_active($self->worldModelObj->autoRescueFirstFlag);
$item_autoRescueFirst->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'autoRescueFirstFlag',
$item_autoRescueFirst->get_active(),
FALSE, # Don't call $self->redrawRegions
'auto_rescue_prompt',
);
}
});
$subMenu_autoRescue->append($item_autoRescueFirst);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_rescue_first', $item_autoRescueFirst);
my $item_autoRescuePrompt = Gtk3::CheckMenuItem->new('_Prompt before merging');
$item_autoRescuePrompt->set_active($self->worldModelObj->autoRescuePromptFlag);
$item_autoRescuePrompt->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'autoRescuePromptFlag',
$item_autoRescuePrompt->get_active(),
FALSE, # Don't call $self->redrawRegions
'auto_rescue_prompt',
);
}
});
$subMenu_autoRescue->append($item_autoRescuePrompt);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_rescue_prompt', $item_autoRescuePrompt);
$subMenu_autoRescue->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_autoRescueNoMove = Gtk3::CheckMenuItem->new('_Don\'t move non-matching rooms');
$item_autoRescueNoMove->set_active($self->worldModelObj->autoRescueNoMoveFlag);
$item_autoRescueNoMove->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'autoRescueNoMoveFlag',
$item_autoRescueNoMove->get_active(),
FALSE, # Don't call $self->redrawRegions
'auto_rescue_no_move',
);
}
});
$subMenu_autoRescue->append($item_autoRescueNoMove);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_rescue_no_move', $item_autoRescueNoMove);
my $item_autoRescueVisits = Gtk3::CheckMenuItem->new(
'_Only update visits in merged rooms',
);
$item_autoRescueVisits->set_active($self->worldModelObj->autoRescueVisitsFlag);
$item_autoRescueVisits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'autoRescueVisitsFlag',
$item_autoRescueVisits->get_active(),
FALSE, # Don't call $self->redrawRegions
'auto_rescue_visits',
);
}
});
$subMenu_autoRescue->append($item_autoRescueVisits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_rescue_visits', $item_autoRescueVisits);
my $item_autoRescueForce = Gtk3::CheckMenuItem->new(
'_Temporarily switch to \'update\' mode',
);
$item_autoRescueForce->set_active($self->worldModelObj->autoRescueForceFlag);
$item_autoRescueForce->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'autoRescueForceFlag',
$item_autoRescueForce->get_active(),
FALSE, # Don't call $self->redrawRegions
'auto_rescue_force',
);
}
});
$subMenu_autoRescue->append($item_autoRescueForce);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_rescue_force', $item_autoRescueForce);
my $item_autoRescue = Gtk3::MenuItem->new('Auto-r_escue mode');
$item_autoRescue->set_submenu($subMenu_autoRescue);
$column_mode->append($item_autoRescue);
# 'Auto-slide mode' submenu
my $subMenu_autoSlide = Gtk3::Menu->new();
my $item_slideMode = Gtk3::RadioMenuItem->new_with_mnemonic(
undef,
'_Don\'t auto-slide new rooms',
);
$item_slideMode->signal_connect('toggled' => sub {
if ($item_slideMode->get_active) {
$self->worldModelObj->setAutoSlideMode('default');
}
});
my $item_slideGroup = $item_slideMode->get_group();
$subMenu_autoSlide->append($item_slideMode);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'slide_default', $item_slideMode);
my $item_slideOrigPull = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_slideGroup,
'Slide original room _backwards',
);
if ($self->worldModelObj->autoSlideMode eq 'orig_pull') {
$item_slideOrigPull->set_active(TRUE);
}
$item_slideOrigPull->signal_connect('toggled' => sub {
if ($item_slideOrigPull->get_active) {
$self->worldModelObj->setAutoSlideMode('orig_pull');
}
});
$subMenu_autoSlide->append($item_slideOrigPull);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'slide_orig_pull', $item_slideOrigPull);
my $item_slideOrigPush = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_slideGroup,
'Slide original room _forwards',
);
if ($self->worldModelObj->autoSlideMode eq 'orig_push') {
$item_slideOrigPush->set_active(TRUE);
}
$item_slideOrigPush->signal_connect('toggled' => sub {
if ($item_slideOrigPush->get_active) {
$self->worldModelObj->setAutoSlideMode('orig_push');
}
});
$subMenu_autoSlide->append($item_slideOrigPush);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'slide_orig_pull', $item_slideOrigPush);
my $item_slideOtherPull = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_slideGroup,
'Slide blocking room b_ackwards',
);
if ($self->worldModelObj->autoSlideMode eq 'other_pull') {
$item_slideOtherPull->set_active(TRUE);
}
$item_slideOtherPull->signal_connect('toggled' => sub {
if ($item_slideOtherPull->get_active) {
$self->worldModelObj->setAutoSlideMode('other_pull');
}
});
$subMenu_autoSlide->append($item_slideOtherPull);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'slide_orig_pull', $item_slideOtherPull);
my $item_slideOtherPush = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_slideGroup,
'Slide blocking room f_orwards',
);
if ($self->worldModelObj->autoSlideMode eq 'other_push') {
$item_slideOtherPush->set_active(TRUE);
}
$item_slideOtherPush->signal_connect('toggled' => sub {
if ($item_slideOtherPush->get_active) {
$self->worldModelObj->setAutoSlideMode('other_push');
}
});
$subMenu_autoSlide->append($item_slideOtherPush);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'slide_orig_pull', $item_slideOtherPush);
my $item_slideDestPull = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_slideGroup,
'Slide new room ba_ckwards',
);
if ($self->worldModelObj->autoSlideMode eq 'dest_pull') {
$item_slideDestPull->set_active(TRUE);
}
$item_slideDestPull->signal_connect('toggled' => sub {
if ($item_slideDestPull->get_active) {
$self->worldModelObj->setAutoSlideMode('dest_pull');
}
});
$subMenu_autoSlide->append($item_slideDestPull);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'slide_orig_pull', $item_slideDestPull);
my $item_slideDestPush = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_slideGroup,
'Slide new room fo_rwards',
);
if ($self->worldModelObj->autoSlideMode eq 'dest_push') {
$item_slideDestPush->set_active(TRUE);
}
$item_slideDestPush->signal_connect('toggled' => sub {
if ($item_slideDestPush->get_active) {
$self->worldModelObj->setAutoSlideMode('dest_push');
}
});
$subMenu_autoSlide->append($item_slideDestPush);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'slide_orig_pull', $item_slideDestPush);
$subMenu_autoSlide->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_slideMax = Gtk3::MenuItem->new('Set _limit on slide distance...');
$item_slideMax->signal_connect('activate' => sub {
$self->autoSlideMaxCallback();
});
$subMenu_autoSlide->append($item_slideMax);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'slide_max', $item_slideMax);
my $item_autoSlide = Gtk3::MenuItem->new('Auto-s_lide mode');
$item_autoSlide->set_submenu($subMenu_autoSlide);
$column_mode->append($item_autoSlide);
$column_mode->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Start-up flags' submenu
my $subMenu_startUpFlags = Gtk3::Menu->new();
my $item_autoOpenWindow = Gtk3::CheckMenuItem->new('Open _automapper on startup');
$item_autoOpenWindow->set_active($self->worldModelObj->autoOpenWinFlag);
$item_autoOpenWindow->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'autoOpenWinFlag',
$item_autoOpenWindow->get_active(),
FALSE, # Don't call $self->redrawRegions
'auto_open_win',
);
}
});
$subMenu_startUpFlags->append($item_autoOpenWindow);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'auto_open_win', $item_autoOpenWindow);
my $item_pseudoWin = Gtk3::CheckMenuItem->new('Open as _pseudo-window');
$item_pseudoWin->set_active($self->worldModelObj->pseudoWinFlag);
$item_pseudoWin->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'pseudoWinFlag',
$item_pseudoWin->get_active(),
FALSE, # Don't call $self->redrawRegions
'pseudo_win',
);
}
});
$subMenu_startUpFlags->append($item_pseudoWin);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'pseudo_win', $item_pseudoWin);
my $item_allowTrackAlone = Gtk3::CheckMenuItem->new('_Follow character after closing');
$item_allowTrackAlone->set_active($self->worldModelObj->allowTrackAloneFlag);
$item_allowTrackAlone->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'allowTrackAloneFlag',
$item_allowTrackAlone->get_active(),
FALSE, # Don't call $self->redrawRegions
'keep_following',
);
}
});
$subMenu_startUpFlags->append($item_allowTrackAlone);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'keep_following', $item_allowTrackAlone);
my $item_startUpFlags = Gtk3::MenuItem->new('S_tart-up flags');
$item_startUpFlags->set_submenu($subMenu_startUpFlags);
$column_mode->append($item_startUpFlags);
# 'Drawing flags' submenu
my $subMenu_drawingFlags = Gtk3::Menu->new();
my $item_roomTagsInCaps = Gtk3::CheckMenuItem->new('_Capitalise room tags');
$item_roomTagsInCaps->set_active($self->worldModelObj->capitalisedRoomTagFlag);
$item_roomTagsInCaps->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'capitalisedRoomTagFlag',
$item_roomTagsInCaps->get_active(),
TRUE, # Do call $self->redrawRegions
'room_tags_capitalised',
);
}
});
$subMenu_drawingFlags->append($item_roomTagsInCaps);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'room_tags_capitalised', $item_roomTagsInCaps);
my $item_drawBentExits = Gtk3::CheckMenuItem->new('Draw _bent broken exits');
$item_drawBentExits->set_active($self->worldModelObj->drawBentExitsFlag);
$item_drawBentExits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'drawBentExitsFlag',
$item_drawBentExits->get_active(),
FALSE, # Don't call $self->redrawRegions
'draw_bent_exits',
);
}
});
$subMenu_drawingFlags->append($item_drawBentExits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_bent_exits', $item_drawBentExits);
my $item_drawRoomEcho = Gtk3::CheckMenuItem->new('Draw _room echos');
$item_drawRoomEcho->set_active($self->worldModelObj->drawRoomEchoFlag);
$item_drawRoomEcho->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'drawRoomEchoFlag',
$item_drawRoomEcho->get_active(),
TRUE, # Do call $self->redrawRegions
'draw_room_echo',
);
}
});
$subMenu_drawingFlags->append($item_drawRoomEcho);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_room_echo', $item_drawRoomEcho);
my $item_showTooltips = Gtk3::CheckMenuItem->new('Show _tooltips');
$item_showTooltips->set_active($self->worldModelObj->showTooltipsFlag);
$item_showTooltips->signal_connect('toggled' => sub {
$self->worldModelObj->toggleShowTooltipsFlag(
$item_showTooltips->get_active(),
);
});
$subMenu_drawingFlags->append($item_showTooltips);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'show_tooltips', $item_showTooltips);
my $item_showNotes = Gtk3::CheckMenuItem->new('Show room _notes in tooltips');
$item_showNotes->set_active($self->worldModelObj->showNotesFlag);
$item_showNotes->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'showNotesFlag',
$item_showNotes->get_active(),
FALSE, # Don't call $self->redrawRegions
'show_notes',
);
}
});
$subMenu_drawingFlags->append($item_showNotes);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'show_notes', $item_showNotes);
my $item_drawingFlags = Gtk3::MenuItem->new('Draw_ing flags');
$item_drawingFlags->set_submenu($subMenu_drawingFlags);
$column_mode->append($item_drawingFlags);
# 'Movement flags' submenu
my $subMenu_moves = Gtk3::Menu->new();
my $item_allowAssisted = Gtk3::CheckMenuItem->new('_Allow assisted moves');
$item_allowAssisted->set_active($self->worldModelObj->assistedMovesFlag);
$item_allowAssisted->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'assistedMovesFlag',
$item_allowAssisted->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_assisted_moves',
);
# The menu items below which set ->protectedMovesFlag and
# ->superProtectedMovesFlag are desensitised if ->assistedMovesFlag is FALSE
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
}
});
$subMenu_moves->append($item_allowAssisted);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'allow_assisted_moves', $item_allowAssisted);
$subMenu_moves->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_assistedBreak = Gtk3::CheckMenuItem->new('_Break doors before move');
$item_assistedBreak->set_active($self->worldModelObj->assistedBreakFlag);
$item_assistedBreak->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'assistedBreakFlag',
$item_assistedBreak->get_active(),
FALSE, # Don't call $self->redrawRegions
'break_before_move',
);
}
});
$subMenu_moves->append($item_assistedBreak);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'break_before_move', $item_assistedBreak);
my $item_assistedPick = Gtk3::CheckMenuItem->new('_Pick doors before move');
$item_assistedPick->set_active($self->worldModelObj->assistedPickFlag);
$item_assistedPick->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'assistedPickFlag',
$item_assistedPick->get_active(),
FALSE, # Don't call $self->redrawRegions
'pick_before_move',
);
}
});
$subMenu_moves->append($item_assistedPick);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'pick_before_move', $item_assistedPick);
my $item_assistedUnlock = Gtk3::CheckMenuItem->new('_Unlock doors before move');
$item_assistedUnlock->set_active($self->worldModelObj->assistedUnlockFlag);
$item_assistedUnlock->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'assistedUnlockFlag',
$item_assistedUnlock->get_active(),
FALSE, # Don't call $self->redrawRegions
'unlock_before_move',
);
}
});
$subMenu_moves->append($item_assistedUnlock);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'unlock_before_move', $item_assistedUnlock);
my $item_assistedOpen = Gtk3::CheckMenuItem->new('_Open doors before move');
$item_assistedOpen->set_active($self->worldModelObj->assistedOpenFlag);
$item_assistedOpen->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'assistedOpenFlag',
$item_assistedOpen->get_active(),
FALSE, # Don't call $self->redrawRegions
'open_before_move',
);
}
});
$subMenu_moves->append($item_assistedOpen);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'open_before_move', $item_assistedOpen);
my $item_assistedClose = Gtk3::CheckMenuItem->new('_Close doors after move');
$item_assistedClose->set_active($self->worldModelObj->assistedCloseFlag);
$item_assistedClose->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'assistedCloseFlag',
$item_assistedClose->get_active(),
FALSE, # Don't call $self->redrawRegions
'close_after_move',
);
}
});
$subMenu_moves->append($item_assistedClose);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'close_after_move', $item_assistedClose);
my $item_assistedLock = Gtk3::CheckMenuItem->new('_Lock doors after move');
$item_assistedLock->set_active($self->worldModelObj->assistedLockFlag);
$item_assistedLock->signal_connect('toggled' => sub {
if (! $self->assistedLockFlag) {
$self->worldModelObj->toggleFlag(
'assistedLockFlag',
$item_assistedLock->get_active(),
FALSE, # Don't call $self->redrawRegions
'lock_after_move',
);
}
});
$subMenu_moves->append($item_assistedLock);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'lock_after_move', $item_assistedLock);
$subMenu_moves->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_allowProtected = Gtk3::CheckMenuItem->new('Allow p_rotected moves');
$item_allowProtected->set_active($self->worldModelObj->protectedMovesFlag);
$item_allowProtected->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'protectedMovesFlag',
$item_allowProtected->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_protected_moves',
);
# The menu item below which sets ->crafyMovesFlag is desensitised if
# ->assistedMovesFlag is false
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
}
});
$subMenu_moves->append($item_allowProtected);
# (Requires $self->worldModelObj->assistedMovesFlag)
$self->ivAdd('menuToolItemHash', 'allow_protected_moves', $item_allowProtected);
my $item_allowSuper = Gtk3::CheckMenuItem->new('Ca_ncel commands when overruled');
$item_allowSuper->set_active($self->worldModelObj->superProtectedMovesFlag);
$item_allowSuper->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'superProtectedMovesFlag',
$item_allowSuper->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_super_protected_moves',
);
}
});
$subMenu_moves->append($item_allowSuper);
# (Requires $self->worldModelObj->assistedMovesFlag)
$self->ivAdd('menuToolItemHash', 'allow_super_protected_moves', $item_allowSuper);
$subMenu_moves->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_allowCrafty = Gtk3::CheckMenuItem->new('Allow crafty _moves');
$item_allowCrafty->set_active($self->worldModelObj->craftyMovesFlag);
$item_allowCrafty->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'craftyMovesFlag',
$item_allowCrafty->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_crafty_moves',
);
}
});
$subMenu_moves->append($item_allowCrafty);
# (Requires $self->worldModelObj->protectedMovesFlag set to be FALSE)
$self->ivAdd('menuToolItemHash', 'allow_crafty_moves', $item_allowCrafty);
my $item_moves = Gtk3::MenuItem->new('Mo_vement flags');
$item_moves->set_submenu($subMenu_moves);
$column_mode->append($item_moves);
# 'Other flags' submenu
my $subMenu_otherFlags = Gtk3::Menu->new();
my $item_allowModelScripts = Gtk3::CheckMenuItem->new('_Allow model-wide scripts');
$item_allowModelScripts->set_active($self->worldModelObj->allowModelScriptFlag);
$item_allowModelScripts->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'allowModelScriptFlag',
$item_allowModelScripts->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_model_scripts',
);
}
});
$subMenu_otherFlags->append($item_allowModelScripts);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'allow_model_scripts', $item_allowModelScripts);
my $item_allowRoomScripts = Gtk3::CheckMenuItem->new(
'Allow ' . $axmud::BASIC_NAME . ' _scripts',
);
$item_allowRoomScripts->set_active($self->worldModelObj->allowRoomScriptFlag);
$item_allowRoomScripts->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'allowRoomScriptFlag',
$item_allowRoomScripts->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_room_scripts',
);
}
});
$subMenu_otherFlags->append($item_allowRoomScripts);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'allow_room_scripts', $item_allowRoomScripts);
my $item_countVisits = Gtk3::CheckMenuItem->new('_Count character visits');
$item_countVisits->set_active($self->worldModelObj->countVisitsFlag);
$item_countVisits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'countVisitsFlag',
$item_countVisits->get_active(),
FALSE, # Don't call $self->redrawRegions
'count_char_visits',
);
}
});
$subMenu_otherFlags->append($item_countVisits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'count_char_visits', $item_countVisits);
my $item_disableUpdate = Gtk3::CheckMenuItem->new('_Disable update mode');
$item_disableUpdate->set_active($self->worldModelObj->disableUpdateModeFlag);
$item_disableUpdate->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleDisableUpdateModeFlag(
$item_disableUpdate->get_active(),
);
}
});
$subMenu_otherFlags->append($item_disableUpdate);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'disable_update_mode', $item_disableUpdate);
my $item_explainGetLost = Gtk3::CheckMenuItem->new('_Explain when getting lost');
$item_explainGetLost->set_active($self->worldModelObj->explainGetLostFlag);
$item_explainGetLost->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'explainGetLostFlag',
$item_explainGetLost->get_active(),
FALSE, # Don't call $self->redrawRegions
'explain_get_lost',
);
}
});
$subMenu_otherFlags->append($item_explainGetLost);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'explain_get_lost', $item_explainGetLost);
my $item_followAnchor = Gtk3::CheckMenuItem->new('New exits for _follow anchors');
$item_followAnchor->set_active($self->worldModelObj->followAnchorFlag);
$item_followAnchor->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'followAnchorFlag',
$item_followAnchor->get_active(),
FALSE, # Don't call $self->redrawRegions
'follow_anchor',
);
}
});
$subMenu_otherFlags->append($item_followAnchor);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'follow_anchor', $item_followAnchor);
my $item_allowCtrlCopy = Gtk3::CheckMenuItem->new('_Move rooms to click with CTRL+C');
$item_allowCtrlCopy->set_active($self->worldModelObj->allowCtrlCopyFlag);
$item_allowCtrlCopy->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'allowCtrlCopyFlag',
$item_allowCtrlCopy->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_ctrl_copy',
);
}
});
$subMenu_otherFlags->append($item_allowCtrlCopy);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'allow_ctrl_copy', $item_allowCtrlCopy);
my $item_showAllPrimary = Gtk3::CheckMenuItem->new('S_how all directions in dialogues');
$item_showAllPrimary->set_active($self->worldModelObj->showAllPrimaryFlag);
$item_showAllPrimary->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'showAllPrimaryFlag',
$item_showAllPrimary->get_active(),
FALSE, # Don't call $self->redrawRegions
'show_all_primary',
);
}
});
$subMenu_otherFlags->append($item_showAllPrimary);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'show_all_primary', $item_showAllPrimary);
my $item_otherFlags = Gtk3::MenuItem->new('_Other flags');
$item_otherFlags->set_submenu($subMenu_otherFlags);
$column_mode->append($item_otherFlags);
# Setup complete
return $column_mode;
}
sub enableRegionsColumn {
# Called by $self->enableMenu
# Sets up the 'Regions' column of the Automapper window's menu bar
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableRegionsColumn', @_);
}
# Set up column
my $column_regions = Gtk3::Menu->new();
if (! $column_regions) {
return undef;
}
my $item_newRegion = Gtk3::ImageMenuItem->new('_New region...');
my $img_newRegion = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_newRegion->set_image($img_newRegion);
$item_newRegion->signal_connect('activate' => sub {
$self->newRegionCallback(FALSE);
});
$column_regions->append($item_newRegion);
my $item_newTempRegion = Gtk3::ImageMenuItem->new('New _temporary region...');
my $img_newTempRegion = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_newTempRegion->set_image($img_newTempRegion);
$item_newTempRegion->signal_connect('activate' => sub {
$self->newRegionCallback(TRUE);
});
$column_regions->append($item_newTempRegion);
$column_regions->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editRegion = Gtk3::ImageMenuItem->new('_Edit region...');
my $img_editRegion = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editRegion->set_image($img_editRegion);
$item_editRegion->signal_connect('activate' => sub {
$self->editRegionCallback();
});
$column_regions->append($item_editRegion);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'edit_region', $item_editRegion);
my $item_editRegionmap = Gtk3::ImageMenuItem->new('Edit _regionmap...');
my $img_editRegionmap = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editRegionmap->set_image($img_editRegionmap);
$item_editRegionmap->signal_connect('activate' => sub {
# Open an 'edit' window for the regionmap
$self->createFreeWin(
'Games::Axmud::EditWin::Regionmap',
$self,
$self->session,
'Edit \'' . $self->currentRegionmap->name . '\' regionmap',
$self->currentRegionmap,
FALSE, # Not temporary
);
});
$column_regions->append($item_editRegionmap);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'edit_regionmap', $item_editRegionmap);
$column_regions->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Region list' submenu
my $subMenu_regionsTree = Gtk3::Menu->new();
my $item_resetList = Gtk3::MenuItem->new('_Reset region list');
$item_resetList->signal_connect('activate' => sub {
$self->worldModelObj->resetRegionList();
});
$subMenu_regionsTree->append($item_resetList);
my $item_reverseList = Gtk3::MenuItem->new('Re_verse region list');
$item_reverseList->signal_connect('activate' => sub {
$self->worldModelObj->reverseRegionList();
});
$subMenu_regionsTree->append($item_reverseList);
$subMenu_regionsTree->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_moveCurrentRegion = Gtk3::MenuItem->new('_Move current region to top');
$item_moveCurrentRegion->signal_connect('activate' => sub {
$self->worldModelObj->moveRegionToTop($self->currentRegionmap);
});
$subMenu_regionsTree->append($item_moveCurrentRegion);
# (Requires $self->currentRegionmap for a region that doesn't have a parent region)
$self->ivAdd('menuToolItemHash', 'move_region_top', $item_moveCurrentRegion);
$subMenu_regionsTree->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_identifyRegion = Gtk3::MenuItem->new('_Identify highlighted region');
$item_identifyRegion->signal_connect('activate' => sub {
$self->identifyRegionCallback();
});
$subMenu_regionsTree->append($item_identifyRegion);
# (Requires $self->treeViewSelectedLine)
$self->ivAdd('menuToolItemHash', 'identify_region', $item_identifyRegion);
my $item_regionsTree = Gtk3::MenuItem->new('Region _list');
$item_regionsTree->set_submenu($subMenu_regionsTree);
$column_regions->append($item_regionsTree);
# 'Current region' submenu
my $subMenu_currentRegion = Gtk3::Menu->new();
my $item_renameRegion = Gtk3::MenuItem->new('_Rename region...');
$item_renameRegion->signal_connect('activate' => sub {
$self->renameRegionCallback();
});
$subMenu_currentRegion->append($item_renameRegion);
my $item_changeParent = Gtk3::MenuItem->new('_Set parent region...');
$item_changeParent->signal_connect('activate' => sub {
$self->changeRegionParentCallback();
});
$subMenu_currentRegion->append($item_changeParent);
$subMenu_currentRegion->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_regionFinished = Gtk3::MenuItem->new('Set f_inished region');
$item_regionFinished->signal_connect('activate' => sub {
$self->regionFinishedCallback();
});
$subMenu_currentRegion->append($item_regionFinished);
$subMenu_currentRegion->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_convertRegionExit = Gtk3::MenuItem->new('_Convert all region exits');
$item_convertRegionExit->signal_connect('activate' => sub {
$self->convertRegionExitCallback(TRUE);
});
$subMenu_currentRegion->append($item_convertRegionExit);
my $item_deconvertRegionExit = Gtk3::MenuItem->new(
'_Deconvert all super-region exits',
);
$item_deconvertRegionExit->signal_connect('activate' => sub {
$self->convertRegionExitCallback(FALSE);
});
$subMenu_currentRegion->append($item_deconvertRegionExit);
$subMenu_currentRegion->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_resetObjectCounts = Gtk3::MenuItem->new('Reset _object counts');
$item_resetObjectCounts->signal_connect('activate' => sub {
# Empty the hashes which store temporary object counts and redraw the region
$self->worldModelObj->resetRegionCounts($self->currentRegionmap);
});
$subMenu_currentRegion->append($item_resetObjectCounts);
my $item_removeRoomFlags = Gtk3::MenuItem->new('Remove room _flags...');
$item_removeRoomFlags->signal_connect('activate' => sub {
$self->removeRoomFlagsCallback();
});
$subMenu_currentRegion->append($item_removeRoomFlags);
my $item_currentRegion = Gtk3::MenuItem->new('C_urrent region');
$item_currentRegion->set_submenu($subMenu_currentRegion);
$column_regions->append($item_currentRegion);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'current_region', $item_currentRegion);
# 'Pre-drawn regions' submenu
my $subMenu_preDrawRegion = Gtk3::Menu->new();
my $item_allowPreDraw = Gtk3::CheckMenuItem->new('_Allow pre-drawing of maps');
$item_allowPreDraw->set_active($self->worldModelObj->preDrawAllowFlag);
$item_allowPreDraw->signal_connect('toggled' => sub {
$self->worldModelObj->toggleFlag(
'preDrawAllowFlag',
$item_allowPreDraw->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_pre_draw',
);
});
$subMenu_preDrawRegion->append($item_allowPreDraw);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'allow_pre_draw', $item_allowPreDraw);
my $item_setPreDrawSize = Gtk3::MenuItem->new('_Set minimum region size');
$item_setPreDrawSize->signal_connect('activate' => sub {
$self->preDrawSizeCallback();
});
$subMenu_preDrawRegion->append($item_setPreDrawSize);
my $item_setRetainSize = Gtk3::MenuItem->new('Set minimum retention size');
$item_setRetainSize->signal_connect('activate' => sub {
$self->preDrawRetainCallback();
});
$subMenu_preDrawRegion->append($item_setRetainSize);
my $item_setPreDrawSpeed = Gtk3::MenuItem->new('Set pre-draw speed');
$item_setPreDrawSpeed->signal_connect('activate' => sub {
$self->preDrawSpeedCallback();
});
$subMenu_preDrawRegion->append($item_setPreDrawSpeed);
$subMenu_preDrawRegion->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_redrawRegion = Gtk3::MenuItem->new('Re_draw this region');
$item_redrawRegion->signal_connect('activate' => sub {
$self->redrawRegions($self->currentRegionmap, TRUE);
});
$subMenu_preDrawRegion->append($item_redrawRegion);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'redraw_region', $item_redrawRegion);
my $item_redrawAllRegions = Gtk3::MenuItem->new('Redraw _all drawn regions');
$item_redrawAllRegions->signal_connect('activate' => sub {
$self->redrawRegionsCallback();
});
$subMenu_preDrawRegion->append($item_redrawAllRegions);
my $item_preDrawRegion = Gtk3::MenuItem->new('_Pre-drawn regions');
$item_preDrawRegion->set_submenu($subMenu_preDrawRegion);
$column_regions->append($item_preDrawRegion);
$column_regions->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Colour schemes' submenu
my $subMenu_regionScheme = Gtk3::Menu->new();
my $item_addScheme = Gtk3::MenuItem->new('_Add new colour scheme...');
$item_addScheme->signal_connect('activate' => sub {
$self->addRegionSchemeCallback();
});
$subMenu_regionScheme->append($item_addScheme);
my $item_editScheme = Gtk3::MenuItem->new('_Edit colour scheme...');
$item_editScheme->signal_connect('activate' => sub {
$self->doRegionSchemeCallback('edit');
});
$subMenu_regionScheme->append($item_editScheme);
my $item_renameScheme = Gtk3::MenuItem->new('_Rename colour scheme...');
$item_renameScheme->signal_connect('activate' => sub {
$self->doRegionSchemeCallback('rename');
});
$subMenu_regionScheme->append($item_renameScheme);
my $item_deleteScheme = Gtk3::MenuItem->new('_Delete colour scheme...');
$item_deleteScheme->signal_connect('activate' => sub {
$self->doRegionSchemeCallback('delete');
});
$subMenu_regionScheme->append($item_deleteScheme);
$subMenu_regionScheme->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'This region' sub-submenu
my $subSubMenu_thisRegionScheme = Gtk3::Menu->new();
my $item_attachScheme = Gtk3::MenuItem->new('_Attach colour scheme...');
$item_attachScheme->signal_connect('activate' => sub {
$self->attachRegionSchemeCallback();
});
$subSubMenu_thisRegionScheme->append($item_attachScheme);
# (Requires $self->currentRegionmap and at least one non-default region colour
# schemes)
$self->ivAdd('menuToolItemHash', 'attach_region_scheme', $item_attachScheme);
my $item_detachScheme = Gtk3::MenuItem->new('_Detach colour scheme');
$item_detachScheme->signal_connect('activate' => sub {
$self->detachRegionSchemeCallback();
});
$subSubMenu_thisRegionScheme->append($item_detachScheme);
# (Requires $self->currentRegionmap with a defined ->regionScheme IV)
$self->ivAdd('menuToolItemHash', 'detach_region_scheme', $item_detachScheme);
$subSubMenu_thisRegionScheme->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editThisScheme = Gtk3::MenuItem->new('_Edit colour scheme...');
$item_editThisScheme->signal_connect('activate' => sub {
$self->doRegionSchemeCallback('edit', $self->currentRegionmap);
});
$subSubMenu_thisRegionScheme->append($item_editThisScheme);
my $item_thisRegionScheme = Gtk3::MenuItem->new('_Current region');
$item_thisRegionScheme->set_submenu($subSubMenu_thisRegionScheme);
$subMenu_regionScheme->append($item_thisRegionScheme);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'this_region_scheme', $item_thisRegionScheme);
my $item_colourScheme = Gtk3::MenuItem->new('Colour sc_hemes');
$item_colourScheme->set_submenu($subMenu_regionScheme);
$column_regions->append($item_colourScheme);
# 'Background colours' submenu
my $subMenu_bgColours = Gtk3::Menu->new();
my $item_removeBGAll = Gtk3::MenuItem->new('_Remove colour...');
$item_removeBGAll->signal_connect('activate' => sub {
$self->removeBGColourCallback();
});
$subMenu_bgColours->append($item_removeBGAll);
my $item_removeBGColour = Gtk3::MenuItem->new('Remove _all colours');
$item_removeBGColour->signal_connect('activate' => sub {
$self->removeBGAllCallback();
});
$subMenu_bgColours->append($item_removeBGColour);
my $item_bgColours = Gtk3::MenuItem->new('_Background colours');
$item_bgColours->set_submenu($subMenu_bgColours);
$column_regions->append($item_bgColours);
# (Requires $self->currentRegionmap whose ->gridColourBlockHash and/or ->gridColourObjHash
# is not empty)
$self->ivAdd('menuToolItemHash', 'empty_bg_colours', $item_bgColours);
$column_regions->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Recalculate paths' submenu
my $subMenu_recalculatePaths = Gtk3::Menu->new();
my $item_recalculateInCurrentRegion = Gtk3::MenuItem->new('In _current region');
$item_recalculateInCurrentRegion->signal_connect('activate' => sub {
$self->recalculatePathsCallback('current');
});
$subMenu_recalculatePaths->append($item_recalculateInCurrentRegion);
# (Requires $self->currentRegionmap and a non-empty
# self->currentRegionmap->gridRoomHash)
$self->ivAdd(
'menuToolItemHash',
'recalculate_in_region',
$item_recalculateInCurrentRegion,
);
my $item_recalculateSelectRegion = Gtk3::MenuItem->new('In _region...');
$item_recalculateSelectRegion->signal_connect('activate' => sub {
$self->recalculatePathsCallback('select');
});
$subMenu_recalculatePaths->append($item_recalculateSelectRegion);
my $item_recalculateAllRegions = Gtk3::MenuItem->new('In _all regions');
$item_recalculateAllRegions->signal_connect('activate' => sub {
$self->recalculatePathsCallback('all');
});
$subMenu_recalculatePaths->append($item_recalculateAllRegions);
$subMenu_recalculatePaths->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_recalculateFromExit = Gtk3::MenuItem->new('For selected _exit');
$item_recalculateFromExit->signal_connect('activate' => sub {
$self->recalculatePathsCallback('exit');
});
$subMenu_recalculatePaths->append($item_recalculateFromExit);
# (Requires $self->currentRegionmap and a $self->selectedExit which is a super-region
# exit)
$self->ivAdd('menuToolItemHash', 'recalculate_from_exit', $item_recalculateFromExit);
my $item_recalculatePaths = Gtk3::MenuItem->new('Re_calculate region paths');
$item_recalculatePaths->set_submenu($subMenu_recalculatePaths);
$column_regions->append($item_recalculatePaths);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'recalculate_paths', $item_recalculatePaths);
# 'Locate current room' submenu
my $subMenu_locateCurrentRoom = Gtk3::Menu->new();
my $item_locateInCurrentRegion = Gtk3::MenuItem->new('In _current region');
$item_locateInCurrentRegion->signal_connect('activate' => sub {
$self->locateCurrentRoomCallback('current');
});
$subMenu_locateCurrentRoom->append($item_locateInCurrentRegion);
# (Requires $self->currentRegionmap and a non-empty GA::Obj::Regionmap->gridRoomHash)
$self->ivAdd('menuToolItemHash', 'locate_room_in_current', $item_locateInCurrentRegion);
my $item_locateInSelectRegion = Gtk3::MenuItem->new('In _region...');
$item_locateInSelectRegion->signal_connect('activate' => sub {
$self->locateCurrentRoomCallback('select');
});
$subMenu_locateCurrentRoom->append($item_locateInSelectRegion);
my $item_locateInAllRegions = Gtk3::MenuItem->new('In _all regions');
$item_locateInAllRegions->signal_connect('activate' => sub {
$self->locateCurrentRoomCallback('all');
});
$subMenu_locateCurrentRoom->append($item_locateInAllRegions);
my $item_locateCurrentRoom = Gtk3::ImageMenuItem->new('L_ocate current room');
my $img_locateCurrentRoom = Gtk3::Image->new_from_stock('gtk-find', 'menu');
$item_locateCurrentRoom->set_image($img_locateCurrentRoom);
$item_locateCurrentRoom->set_submenu($subMenu_locateCurrentRoom);
$column_regions->append($item_locateCurrentRoom);
# 'Screenshots' submenu
my $subMenu_screenshots = Gtk3::Menu->new();
my $item_visibleScreenshot = Gtk3::MenuItem->new('_Visible map');
$item_visibleScreenshot->signal_connect('activate' => sub {
$self->regionScreenshotCallback('visible');
});
$subMenu_screenshots->append($item_visibleScreenshot);
my $item_occupiedScreenshot = Gtk3::MenuItem->new('_Occupied portion');
$item_occupiedScreenshot->signal_connect('activate' => sub {
$self->regionScreenshotCallback('occupied');
});
$subMenu_screenshots->append($item_occupiedScreenshot);
my $item_wholeScreenshot = Gtk3::MenuItem->new('_Whole region');
$item_wholeScreenshot->signal_connect('activate' => sub {
$self->regionScreenshotCallback('whole');
});
$subMenu_screenshots->append($item_wholeScreenshot);
my $item_screenshots = Gtk3::MenuItem->new('Take _screenshot');
$item_screenshots->set_submenu($subMenu_screenshots);
$column_regions->append($item_screenshots);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'screenshots', $item_screenshots);
$column_regions->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_emptyRegion = Gtk3::MenuItem->new('E_mpty region');
$item_emptyRegion->signal_connect('activate' => sub {
$self->emptyRegionCallback();
});
$column_regions->append($item_emptyRegion);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'empty_region', $item_emptyRegion);
my $item_deleteRegion = Gtk3::ImageMenuItem->new('_Delete region');
my $img_deleteRegion = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_deleteRegion->set_image($img_deleteRegion);
$item_deleteRegion->signal_connect('activate' => sub {
$self->deleteRegionCallback();
});
$column_regions->append($item_deleteRegion);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'delete_region', $item_deleteRegion);
my $item_deleteTempRegion = Gtk3::ImageMenuItem->new('Delete temporar_y regions');
my $img_deleteTempRegion = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_deleteTempRegion->set_image($img_deleteTempRegion);
$item_deleteTempRegion->signal_connect('activate' => sub {
$self->deleteTempRegionsCallback();
});
$column_regions->append($item_deleteTempRegion);
# Setup complete
return $column_regions;
}
sub enableRoomsColumn {
# Called by $self->enableMenu
# Sets up the 'Rooms' column of the Automapper window's menu bar
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableRoomsColumn', @_);
}
# Set up column
my $column_rooms = Gtk3::Menu->new();
if (! $column_rooms) {
return undef;
}
my $item_setCurrentRoom = Gtk3::MenuItem->new('_Set current room');
$item_setCurrentRoom->signal_connect('activate' => sub {
$self->mapObj->setCurrentRoom($self->selectedRoom);
});
$column_rooms->append($item_setCurrentRoom);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'set_current_room', $item_setCurrentRoom);
my $item_unsetCurrentRoom = Gtk3::MenuItem->new('_Unset current room');
$item_unsetCurrentRoom->signal_connect('activate' => sub {
# This function automatically redraws the room
$self->mapObj->setCurrentRoom();
});
$column_rooms->append($item_unsetCurrentRoom);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'unset_current_room', $item_unsetCurrentRoom);
$column_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Locator task' submenu
my $subMenu_locatorTask = Gtk3::Menu->new();
my $item_resetLocator = Gtk3::MenuItem->new('_Reset Locator');
$item_resetLocator->signal_connect('activate' => sub {
$self->resetLocatorCallback();
});
$subMenu_locatorTask->append($item_resetLocator);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'reset_locator', $item_resetLocator);
my $item_updateLocator = Gtk3::MenuItem->new('_Update Locator');
$item_updateLocator->signal_connect('activate' => sub {
# Update the Locator task
$self->mapObj->updateLocator();
});
$subMenu_locatorTask->append($item_updateLocator);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'update_locator', $item_updateLocator);
$subMenu_locatorTask->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setFacing = Gtk3::MenuItem->new('_Set facing direction...');
$item_setFacing->signal_connect('activate' => sub {
$self->setFacingCallback();
});
$subMenu_locatorTask->append($item_setFacing);
my $item_resetFacing = Gtk3::MenuItem->new('R_eset facing direction...');
$item_resetFacing->signal_connect('activate' => sub {
$self->resetFacingCallback();
});
$subMenu_locatorTask->append($item_resetFacing);
$subMenu_locatorTask->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_viewLocatorRoom = Gtk3::MenuItem->new('_View Locator room...');
$item_viewLocatorRoom->signal_connect('activate' => sub {
$self->editLocatorRoomCallback();
});
$subMenu_locatorTask->append($item_viewLocatorRoom);
my $item_locatorTask = Gtk3::MenuItem->new('_Locator task');
$item_locatorTask->set_submenu($subMenu_locatorTask);
$column_rooms->append($item_locatorTask);
# 'Pathfinding' submenu
my $subMenu_pathFinding = Gtk3::Menu->new();
my $item_highlightPath = Gtk3::MenuItem->new('_Highlight path');
$item_highlightPath->signal_connect('activate' => sub {
$self->processPathCallback('select_room');
});
$subMenu_pathFinding->append($item_highlightPath);
# (Requires $self->currentRegionmap, $self->mapObj->currentRoom and $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'path_finding_highlight', $item_highlightPath);
my $item_displayPath = Gtk3::MenuItem->new('_Edit path...');
$item_displayPath->signal_connect('activate' => sub {
$self->processPathCallback('pref_win');
});
$subMenu_pathFinding->append($item_displayPath);
# (Requires $self->currentRegionmap, $self->mapObj->currentRoom and $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'path_finding_edit', $item_displayPath);
my $item_goToRoom = Gtk3::MenuItem->new('_Go to room');
$item_goToRoom->signal_connect('activate' => sub {
$self->processPathCallback('send_char');
});
$subMenu_pathFinding->append($item_goToRoom);
# (Requires $self->currentRegionmap, $self->mapObj->currentRoom and $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'path_finding_go', $item_goToRoom);
$subMenu_pathFinding->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_allowPostProcessing = Gtk3::CheckMenuItem->new('_Allow post-processing');
$item_allowPostProcessing->set_active($self->worldModelObj->postProcessingFlag);
$item_allowPostProcessing->signal_connect('toggled' => sub {
$self->worldModelObj->toggleFlag(
'postProcessingFlag',
$item_allowPostProcessing->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_post_process',
);
});
$subMenu_pathFinding->append($item_allowPostProcessing);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'allow_post_process', $item_allowPostProcessing);
my $item_avoidHazardousRooms = Gtk3::CheckMenuItem->new('A_void hazardous rooms');
$item_avoidHazardousRooms->set_active($self->worldModelObj->avoidHazardsFlag);
$item_avoidHazardousRooms->signal_connect('toggled' => sub {
$self->worldModelObj->toggleFlag(
'avoidHazardsFlag',
$item_avoidHazardousRooms->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_hazard_rooms',
);
});
$subMenu_pathFinding->append($item_avoidHazardousRooms);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'allow_hazard_rooms', $item_avoidHazardousRooms);
my $item_doubleClickPathFind = Gtk3::CheckMenuItem->new(
'Allow _double-click moves',
);
$item_doubleClickPathFind->set_active($self->worldModelObj->quickPathFindFlag);
$item_doubleClickPathFind->signal_connect('toggled' => sub {
$self->worldModelObj->toggleFlag(
'quickPathFindFlag',
$item_doubleClickPathFind->get_active(),
FALSE, # Don't call $self->redrawRegions
'allow_quick_path_find',
);
});
$subMenu_pathFinding->append($item_doubleClickPathFind);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'allow_quick_path_find', $item_doubleClickPathFind);
$subMenu_pathFinding->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_adjacentMode = Gtk3::MenuItem->new('_Set adjacent regions mode...');
$item_adjacentMode->signal_connect('activate' => sub {
$self->adjacentModeCallback();
});
$subMenu_pathFinding->append($item_adjacentMode);
my $item_pathFinding = Gtk3::MenuItem->new('_Pathfinding');
$item_pathFinding->set_submenu($subMenu_pathFinding);
$column_rooms->append($item_pathFinding);
# 'Move rooms/labels' submenu
my $subMenu_moveRooms = Gtk3::Menu->new();
my $item_moveSelected = Gtk3::MenuItem->new('Move in _direction...');
$item_moveSelected->signal_connect('activate' => sub {
$self->moveSelectedRoomsCallback();
});
$subMenu_moveRooms->append($item_moveSelected);
# (Requires $self->currentRegionmap and one or more selected rooms)
$self->ivAdd('menuToolItemHash', 'move_rooms_dir', $item_moveSelected);
my $item_moveSelectedToClick = Gtk3::MenuItem->new('Move to _click');
$item_moveSelectedToClick->signal_connect('activate' => sub {
# Set the free clicking mode: $self->mouseClickEvent will move the objects when the
# user next clicks on an empty part of the map
$self->set_freeClickMode('move_room');
});
$subMenu_moveRooms->append($item_moveSelectedToClick);
# (Requires $self->currentRegionmap and one or more selected rooms)
$self->ivAdd('menuToolItemHash', 'move_rooms_click', $item_moveSelectedToClick);
$subMenu_moveRooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Transfer to region' sub-submenu
my $subSubMenu_transferRegion = Gtk3::Menu->new();
if ($self->recentRegionList) {
foreach my $name ($self->recentRegionList) {
my $item_regionName = Gtk3::MenuItem->new($name);
$item_regionName->signal_connect('activate' => sub {
$self->transferSelectedRoomsCallback($name);
});
$subSubMenu_transferRegion->append($item_regionName);
}
} else {
my $item_regionNone = Gtk3::MenuItem->new('(No recent regions)');
$item_regionNone->set_sensitive(FALSE);
$subSubMenu_transferRegion->append($item_regionNone);
}
$subSubMenu_transferRegion->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_transferSelect = Gtk3::MenuItem->new('Select region...');
$item_transferSelect->signal_connect('activate' => sub {
$self->transferSelectedRoomsCallback();
});
$subSubMenu_transferRegion->append($item_transferSelect);
my $item_transferRegion = Gtk3::MenuItem->new('_Transfer to region');
$item_transferRegion->set_submenu($subSubMenu_transferRegion);
$subMenu_moveRooms->append($item_transferRegion);
# (Requires $self->currentRegionmap, one or more selected rooms and at least two regions
# in the world model)
$self->ivAdd('menuToolItemHash', 'transfer_to_region', $item_transferRegion);
$subMenu_moveRooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_mergeMoveRooms = Gtk3::MenuItem->new('_Merge/move rooms');
$item_mergeMoveRooms->signal_connect('activate' => sub {
$self->doMerge($self->mapObj->currentRoom);
});
$subMenu_moveRooms->append($item_mergeMoveRooms);
# (Requires $self->currentRegionmap, a current room and the automapper object being set
# up to perform a merge)
$self->ivAdd('menuToolItemHash', 'move_merge_rooms', $item_mergeMoveRooms);
my $item_moveRooms = Gtk3::MenuItem->new('_Move rooms/labels');
$item_moveRooms->set_submenu($subMenu_moveRooms);
$column_rooms->append($item_moveRooms);
# (Requires $self->currentRegionmap and EITHER one or more selected rooms OR a current room
# and the automapper being set up to perform a merge)
$self->ivAdd('menuToolItemHash', 'move_rooms_labels', $item_moveRooms);
$column_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Add room' submenu
my $subMenu_addRoom = Gtk3::Menu->new();
my $item_addFirstRoom = Gtk3::MenuItem->new('Add _first room');
$item_addFirstRoom->signal_connect('activate' => sub {
$self->addFirstRoomCallback();
});
$subMenu_addRoom->append($item_addFirstRoom);
# (Requires $self->currentRegionmap & an empty $self->currentRegionmap->gridRoomHash)
$self->ivAdd('menuToolItemHash', 'add_first_room', $item_addFirstRoom);
my $item_addRoomAtClick = Gtk3::MenuItem->new('Add room at _click');
$item_addRoomAtClick->signal_connect('activate' => sub {
# Set the free clicking mode: $self->mouseClickEvent will create the new room when
# the user next clicks on an empty part of the map
if ($self->currentRegionmap) {
$self->set_freeClickMode('add_room');
}
});
$subMenu_addRoom->append($item_addRoomAtClick);
my $item_addRoomAtBlock = Gtk3::MenuItem->new('Add room at _block...');
$item_addRoomAtBlock->signal_connect('activate' => sub {
$self->addRoomAtBlockCallback();
});
$subMenu_addRoom->append($item_addRoomAtBlock);
my $item_addRoom = Gtk3::ImageMenuItem->new('Add _room');
my $img_addRoom = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_addRoom->set_image($img_addRoom);
$item_addRoom->set_submenu($subMenu_addRoom);
$column_rooms->append($item_addRoom);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'add_room', $item_addRoom);
# 'Add pattern' submenu
my $subMenu_exitPatterns = Gtk3::Menu->new();
my $item_addFailedExitWorld = Gtk3::MenuItem->new('Add failed exit to _world...');
$item_addFailedExitWorld->signal_connect('activate' => sub {
$self->addFailedExitCallback(TRUE);
});
$subMenu_exitPatterns->append($item_addFailedExitWorld);
my $item_addFailedExitRoom = Gtk3::MenuItem->new('Add failed exit to current _room...');
$item_addFailedExitRoom->signal_connect('activate' => sub {
$self->addFailedExitCallback(FALSE, $self->mapObj->currentRoom);
});
$subMenu_exitPatterns->append($item_addFailedExitRoom);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'add_failed_room', $item_addFailedExitRoom);
$subMenu_exitPatterns->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addInvoluntaryExitRoom = Gtk3::MenuItem->new(
'Add _involuntary exit to current room...',
);
$item_addInvoluntaryExitRoom->signal_connect('activate' => sub {
$self->addInvoluntaryExitCallback($self->mapObj->currentRoom);
});
$subMenu_exitPatterns->append($item_addInvoluntaryExitRoom);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'add_involuntary_exit', $item_addInvoluntaryExitRoom);
my $item_addRepulseExitRoom = Gtk3::MenuItem->new(
'Add r_epulse exit to current room...',
);
$item_addRepulseExitRoom->signal_connect('activate' => sub {
$self->addRepulseExitCallback($self->mapObj->currentRoom);
});
$subMenu_exitPatterns->append($item_addRepulseExitRoom);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'add_repulse_exit', $item_addRepulseExitRoom);
$subMenu_exitPatterns->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addSpecialDepartRoom = Gtk3::MenuItem->new(
'Add _special departure to current room...',
);
$item_addSpecialDepartRoom->signal_connect('activate' => sub {
$self->addSpecialDepartureCallback($self->mapObj->currentRoom);
});
$subMenu_exitPatterns->append($item_addSpecialDepartRoom);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'add_special_depart', $item_addSpecialDepartRoom);
my $item_addUnspecifiedRoom = Gtk3::MenuItem->new(
'Add _unspecified room pattern...',
);
$item_addUnspecifiedRoom->signal_connect('activate' => sub {
$self->addUnspecifiedPatternCallback($self->mapObj->currentRoom);
});
$subMenu_exitPatterns->append($item_addUnspecifiedRoom);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd('menuToolItemHash', 'add_unspecified_pattern', $item_addUnspecifiedRoom);
my $item_exitPatterns = Gtk3::MenuItem->new('Add p_attern');
$item_exitPatterns->set_submenu($subMenu_exitPatterns);
$column_rooms->append($item_exitPatterns);
# 'Add to model' submenu
my $subMenu_addToModel = Gtk3::Menu->new();
my $item_addRoomContents = Gtk3::MenuItem->new('Add _contents...');
$item_addRoomContents->signal_connect('activate' => sub {
$self->addContentsCallback(FALSE);
});
$subMenu_addToModel->append($item_addRoomContents);
# Requires $self->currentRegionmap, $self->mapObj->currentRoom
$self->ivAdd('menuToolItemHash', 'add_room_contents', $item_addRoomContents);
my $item_addContentsString = Gtk3::MenuItem->new('Add c_ontents from string...');
$item_addContentsString->signal_connect('activate' => sub {
$self->addContentsCallback(TRUE);
});
$subMenu_addToModel->append($item_addContentsString);
# Requires $self->currentRegionmap, $self->selectedRoom
$self->ivAdd('menuToolItemHash', 'add_contents_string', $item_addContentsString);
$subMenu_addToModel->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addHiddenObj = Gtk3::MenuItem->new('Add _hidden object...');
$item_addHiddenObj->signal_connect('activate' => sub {
$self->addHiddenObjCallback(FALSE);
});
$subMenu_addToModel->append($item_addHiddenObj);
# Requires $self->currentRegionmap, $self->mapObj->currentRoom
$self->ivAdd('menuToolItemHash', 'add_hidden_object', $item_addHiddenObj);
my $item_addHiddenString = Gtk3::MenuItem->new('Add h_idden object from string...');
$item_addHiddenString->signal_connect('activate' => sub {
$self->addHiddenObjCallback(TRUE);
});
$subMenu_addToModel->append($item_addHiddenString);
# Requires $self->currentRegionmap, $self->selectedRoom
$self->ivAdd('menuToolItemHash', 'add_hidden_string', $item_addHiddenString);
$subMenu_addToModel->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addSearchResult = Gtk3::MenuItem->new('Add _search result...');
$item_addSearchResult->signal_connect('activate' => sub {
$self->addSearchResultCallback();
});
$subMenu_addToModel->append($item_addSearchResult);
# Requires $self->currentRegionmap and $self->mapObj->currentRoom
$self->ivAdd('menuToolItemHash', 'add_search_result', $item_addSearchResult);
my $item_addToModel = Gtk3::MenuItem->new('Add to m_odel');
$item_addToModel->set_submenu($subMenu_addToModel);
$column_rooms->append($item_addToModel);
# Requires $self->currentRegionmap and either $self->mapObj->currentRoom or
# $self->selectedRoom
$self->ivAdd('menuToolItemHash', 'add_to_model', $item_addToModel);
$column_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Add/set exits' submenu
my $subMenu_setExits = Gtk3::Menu->new();
my $item_addNormal = Gtk3::MenuItem->new('Add _normal exit...');
$item_addNormal->signal_connect('activate' => sub {
$self->addExitCallback(FALSE); # FALSE - not a hidden exit
});
$subMenu_setExits->append($item_addNormal);
# (Requires $self->currentRegionmap and a $self->selectedRoom whose ->wildMode is not
# 'wild' - the value 'border' is ok, though)
$self->ivAdd('menuToolItemHash', 'add_normal_exit', $item_addNormal);
my $item_addHiddenExit = Gtk3::MenuItem->new('Add _hidden exit...');
$item_addHiddenExit->signal_connect('activate' => sub {
$self->addExitCallback(TRUE); # TRUE - a hidden exit
});
$subMenu_setExits->append($item_addHiddenExit);
# (Requires $self->currentRegionmap and a $self->selectedRoom whose ->wildMode is not
# 'wild' - the value 'border' is ok, though)
$self->ivAdd('menuToolItemHash', 'add_hidden_exit', $item_addHiddenExit);
$subMenu_setExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addMultiple = Gtk3::MenuItem->new('Add _multiple exits...');
$item_addMultiple->signal_connect('activate' => sub {
$self->addMultipleExitsCallback();
});
$subMenu_setExits->append($item_addMultiple);
# (Requires $self->currentRegionmap and one or more selected rooms)
$self->ivAdd('menuToolItemHash', 'add_multiple_exits', $item_addMultiple);
$subMenu_setExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_removeChecked = Gtk3::MenuItem->new('Remove _checked direction...');
$item_removeChecked->signal_connect('activate' => sub {
$self->removeCheckedDirCallback(FALSE);
});
$subMenu_setExits->append($item_removeChecked);
# (Require a current regionmap, a single selected room that has one or more checked
# directions)
$self->ivAdd('menuToolItemHash', 'remove_checked', $item_removeChecked);
my $item_removeCheckedAll = Gtk3::MenuItem->new('Remove _all checked directions');
$item_removeCheckedAll->signal_connect('activate' => sub {
$self->removeCheckedDirCallback(TRUE);
});
$subMenu_setExits->append($item_removeCheckedAll);
# (Require a current regionmap, a single selected room that has one or more checked
# directions)
$self->ivAdd('menuToolItemHash', 'remove_checked_all', $item_removeCheckedAll);
$subMenu_setExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_markNormal = Gtk3::MenuItem->new('Mark room(s) as n_ormal');
$item_markNormal->signal_connect('activate' => sub {
$self->setWildCallback('normal');
});
$subMenu_setExits->append($item_markNormal);
# (Require a current regionmap and one or more selected rooms)
$self->ivAdd('menuToolItemHash', 'wilderness_normal', $item_markNormal);
my $item_markWild = Gtk3::MenuItem->new('Mark room(s) as _wilderness');
$item_markWild->signal_connect('activate' => sub {
$self->setWildCallback('wild');
});
$subMenu_setExits->append($item_markWild);
# (Require a current regionmap, one or more selected rooms and
# $self->session->currentWorld->basicMappingFlag to be FALSE)
$self->ivAdd('menuToolItemHash', 'wilderness_wild', $item_markWild);
my $item_markBorder = Gtk3::MenuItem->new('Mark room(s) as wilderness _border');
$item_markBorder->signal_connect('activate' => sub {
$self->setWildCallback('border');
});
$subMenu_setExits->append($item_markBorder);
# (Require a current regionmap, one or more selected rooms and
# $self->session->currentWorld->basicMappingFlag to be FALSE)
$self->ivAdd('menuToolItemHash', 'wilderness_border', $item_markBorder);
my $item_setExits = Gtk3::ImageMenuItem->new('Add/set _exits');
my $img_setExits = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_setExits->set_image($img_setExits);
$item_setExits->set_submenu($subMenu_setExits);
$column_rooms->append($item_setExits);
# (Require a current regionmap and one or more selected rooms)
$self->ivAdd('menuToolItemHash', 'set_exits', $item_setExits);
my $item_selectExit = Gtk3::MenuItem->new('Select e_xit in room...');
$item_selectExit->signal_connect('activate' => sub {
$self->selectExitCallback();
});
$column_rooms->append($item_selectExit);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'select_exit', $item_selectExit);
$column_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editRoom = Gtk3::ImageMenuItem->new('Ed_it room...');
my $img_editRoom = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editRoom->set_image($img_editRoom);
$item_editRoom->signal_connect('activate' => sub {
# Open the room's 'edit' window
$self->createFreeWin(
'Games::Axmud::EditWin::ModelObj::Room',
$self,
$self->session,
'Edit ' . $self->selectedRoom->category . ' model object',
$self->selectedRoom,
FALSE, # Not temporary
);
});
$column_rooms->append($item_editRoom);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'edit_room', $item_editRoom);
# 'Room text' submenu
my $subMenu_roomText = Gtk3::Menu->new();
my $item_setRoomTag = Gtk3::MenuItem->new('Set room _tag...');
$item_setRoomTag->signal_connect('activate' => sub {
$self->setRoomTagCallback();
});
$subMenu_roomText->append($item_setRoomTag);
# (Requires $self->currentRegionmap and either $self->selectedRoom or
# $self->selectedRoomTag)
$self->ivAdd('menuToolItemHash', 'set_room_tag', $item_setRoomTag);
my $item_setGuild = Gtk3::MenuItem->new('Set room _guild...');
$item_setGuild->signal_connect('activate' => sub {
$self->setRoomGuildCallback();
});
$subMenu_roomText->append($item_setGuild);
# (Requires $self->currentRegionmap and one or more of $self->selectedRoom,
# $self->selectedRoomHash, $self->selectedRoomGuild, $self->selectedRoomGuildHash)
$self->ivAdd('menuToolItemHash', 'set_room_guild', $item_setGuild);
$subMenu_roomText->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_resetPositions = Gtk3::MenuItem->new('_Reset text positions');
$item_resetPositions->signal_connect('activate' => sub {
$self->resetRoomOffsetsCallback();
});
$subMenu_roomText->append($item_resetPositions);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'reset_positions', $item_resetPositions);
$subMenu_roomText->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_roomText = Gtk3::MenuItem->new('Set room _text');
$item_roomText->set_submenu($subMenu_roomText);
$column_rooms->append($item_roomText);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'room_text', $item_roomText);
# 'Toggle room flag' submenu
my $subMenu_toggleRoomFlag = Gtk3::Menu->new();
if ($self->worldModelObj->roomFlagShowMode eq 'default') {
# Show all room flags, sorted by filter
foreach my $filter ($axmud::CLIENT->constRoomFilterList) {
# A sub-sub menu for $filter
my $subSubMenu_filter = Gtk3::Menu->new();
my @nameList = $self->worldModelObj->getRoomFlagsInFilter($filter);
foreach my $name (@nameList) {
my $obj = $self->worldModelObj->ivShow('roomFlagHash', $name);
if ($obj) {
my $menuItem = Gtk3::MenuItem->new($obj->descrip);
$menuItem->signal_connect('activate' => sub {
# Toggle the flags for all selected rooms, redraw them and (if the
# flag is one of the hazardous room flags) recalculate the
# regionmap's paths. The TRUE argument tells the world model to
# redraw the rooms
$self->worldModelObj->toggleRoomFlags(
$self->session,
TRUE,
$obj->name,
$self->compileSelectedRooms(),
);
});
$subSubMenu_filter->append($menuItem);
}
}
if (! @nameList) {
my $menuItem = Gtk3::MenuItem->new('(No flags in this filter)');
$menuItem->set_sensitive(FALSE);
$subSubMenu_filter->append($menuItem);
}
my $menuItem = Gtk3::MenuItem->new(ucfirst($filter));
$menuItem->set_submenu($subSubMenu_filter);
$subMenu_toggleRoomFlag->append($menuItem);
}
} else {
# Show selected room flags, sorted only by priority
my %showHash = $self->worldModelObj->getVisibleRoomFlags();
if (%showHash) {
foreach my $obj (sort {$a->priority <=> $b->priority} (values %showHash)) {
my $menuItem = Gtk3::MenuItem->new($obj->descrip);
$menuItem->signal_connect('activate' => sub {
# Toggle the flags for all selected rooms, redraw them and (if the
# flag is one of the hazardous room flags) recalculate the
# regionmap's paths. The TRUE argument tells the world model to
# redraw the rooms
$self->worldModelObj->toggleRoomFlags(
$self->session,
TRUE,
$obj->name,
$self->compileSelectedRooms(),
);
});
$subMenu_toggleRoomFlag->append($menuItem);
}
} else {
my $menuItem = Gtk3::MenuItem->new('(None are marked visible)');
$menuItem->set_sensitive(FALSE);
$subMenu_toggleRoomFlag->append($menuItem);
}
}
my $item_toggleRoomFlag = Gtk3::MenuItem->new('Toggle room _flags');
$item_toggleRoomFlag->set_submenu($subMenu_toggleRoomFlag);
$column_rooms->append($item_toggleRoomFlag);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'toggle_room_flag_sub', $item_toggleRoomFlag);
# 'Other room features' submenu
my $subMenu_roomFeatures = Gtk3::Menu->new();
# 'Update character visits' sub-submenu
my $subSubMenu_updateVisits = Gtk3::Menu->new();
my $item_increaseSetCurrent = Gtk3::MenuItem->new('Increase & set _current');
$item_increaseSetCurrent->signal_connect('activate' => sub {
$self->updateVisitsCallback('increase');
$self->mapObj->setCurrentRoom($self->selectedRoom);
});
$subSubMenu_updateVisits->append($item_increaseSetCurrent);
# (Requires $self->currentRegionmap and $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'increase_set_current', $item_increaseSetCurrent);
$subSubMenu_updateVisits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_increaseVisits = Gtk3::MenuItem->new('_Increase by one');
$item_increaseVisits->signal_connect('activate' => sub {
$self->updateVisitsCallback('increase');
});
$subSubMenu_updateVisits->append($item_increaseVisits);
my $item_decreaseVisits = Gtk3::MenuItem->new('_Decrease by one');
$item_decreaseVisits->signal_connect('activate' => sub {
$self->updateVisitsCallback('decrease');
});
$subSubMenu_updateVisits->append($item_decreaseVisits);
my $item_manualVisits = Gtk3::MenuItem->new('Set _manually');
$item_manualVisits->signal_connect('activate' => sub {
$self->updateVisitsCallback('manual');
});
$subSubMenu_updateVisits->append($item_manualVisits);
my $item_resetVisits = Gtk3::MenuItem->new('_Reset to zero');
$item_resetVisits->signal_connect('activate' => sub {
$self->updateVisitsCallback('reset');
});
$subSubMenu_updateVisits->append($item_resetVisits);
$subSubMenu_updateVisits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_toggleGraffiti = Gtk3::MenuItem->new('Toggle _graffiti');
$item_toggleGraffiti->signal_connect('activate' => sub {
$self->toggleGraffitiCallback();
});
$subSubMenu_updateVisits->append($item_toggleGraffiti);
# (Requires $self->currentRegionmap, $self->graffitiModeFlag & one or more selected
# rooms)
$self->ivAdd('menuToolItemHash', 'toggle_graffiti', $item_toggleGraffiti);
my $item_updateVisits = Gtk3::MenuItem->new('Update character _visits');
$item_updateVisits->set_submenu($subSubMenu_updateVisits);
$subMenu_roomFeatures->append($item_updateVisits);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'update_visits', $item_updateVisits);
# 'Room exclusivity' sub-submenu
my $subSubMenu_exclusivity = Gtk3::Menu->new();
my $item_toggleExclusivity = Gtk3::MenuItem->new('_Toggle exclusivity');
$item_toggleExclusivity->signal_connect('activate' => sub {
$self->toggleExclusiveProfileCallback();
});
$subSubMenu_exclusivity->append($item_toggleExclusivity);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'toggle_exclusivity', $item_toggleExclusivity);
$subSubMenu_exclusivity->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addExclusiveProf = Gtk3::MenuItem->new('_Add exclusive profile...');
$item_addExclusiveProf->signal_connect('activate' => sub {
$self->addExclusiveProfileCallback();
});
$subSubMenu_exclusivity->append($item_addExclusiveProf);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'add_exclusive_prof', $item_addExclusiveProf);
my $item_clearExclusiveProf = Gtk3::MenuItem->new('_Clear exclusive profiles');
$item_clearExclusiveProf->signal_connect('activate' => sub {
$self->resetExclusiveProfileCallback();
});
$subSubMenu_exclusivity->append($item_clearExclusiveProf);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'clear_exclusive_profs', $item_clearExclusiveProf);
my $item_exclusivity = Gtk3::MenuItem->new('Room _exclusivity');
$item_exclusivity->set_submenu($subSubMenu_exclusivity);
$subMenu_roomFeatures->append($item_exclusivity);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'room_exclusivity', $item_exclusivity);
# 'Source code' sub-submenu
my $subSubMenu_sourceCode = Gtk3::Menu->new();
my $item_setFilePath = Gtk3::MenuItem->new('_Set file path...');
$item_setFilePath->signal_connect('activate' => sub {
$self->setFilePathCallback();
});
$subSubMenu_sourceCode->append($item_setFilePath);
# (Requires $self->currentRegionmap and $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'set_file_path', $item_setFilePath);
my $item_setVirtualArea = Gtk3::MenuItem->new('Set virtual _area...');
$item_setVirtualArea->signal_connect('activate' => sub {
$self->setVirtualAreaCallback(TRUE);
});
$subSubMenu_sourceCode->append($item_setVirtualArea);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'set_virtual_area', $item_setVirtualArea);
my $item_resetVirtualArea = Gtk3::MenuItem->new('_Reset virtual area...');
$item_resetVirtualArea->signal_connect('activate' => sub {
$self->setVirtualAreaCallback(FALSE);
});
$subSubMenu_sourceCode->append($item_resetVirtualArea);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'reset_virtual_area', $item_resetVirtualArea);
my $item_showSourceCode = Gtk3::MenuItem->new('S_how file paths');
$item_showSourceCode->signal_connect('activate' => sub {
# (Don't use $self->pseudoCmdMode - we want to see the footer messages)
$self->session->pseudoCmd('listsourcecode', 'show_all');
});
$subSubMenu_sourceCode->append($item_showSourceCode);
$subSubMenu_sourceCode->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_viewSourceCode = Gtk3::MenuItem->new('_View file...');
$item_viewSourceCode->signal_connect('activate' => sub {
$self->quickFreeWin(
'Games::Axmud::OtherWin::SourceCode',
$self->session,
# Config
'model_obj' => $self->selectedRoom,
);
});
$subSubMenu_sourceCode->append($item_viewSourceCode);
# (Requires $self->currentRegionmap, $self->selectedRoom &
# $self->selectedRoom->sourceCodePath & empty
# $self->selectedRoom->virtualAreaPath)
$self->ivAdd('menuToolItemHash', 'view_source_code', $item_viewSourceCode);
my $item_editSourceCode = Gtk3::MenuItem->new('_Edit file...');
$item_editSourceCode->signal_connect('activate' => sub {
$self->editFileCallback();
});
$subSubMenu_sourceCode->append($item_editSourceCode);
# (Requires $self->currentRegionmap, $self->selectedRoom &
# $self->selectedRoom->sourceCodePath & empty
# $self->selectedRoom->virtualAreaPath)
$self->ivAdd('menuToolItemHash', 'edit_source_code', $item_editSourceCode);
$subSubMenu_sourceCode->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_viewVirtualArea = Gtk3::MenuItem->new('View virtual area _file...');
$item_viewVirtualArea->signal_connect('activate' => sub {
$self->quickFreeWin(
'Games::Axmud::OtherWin::SourceCode',
$self->session,
# Config
'model_obj' => $self->selectedRoom,
'virtual_flag' => TRUE,
);
});
$subSubMenu_sourceCode->append($item_viewVirtualArea);
# (Requires $self->currentRegionmap, $self->selectedRoom &
# $self->selectedRoom->virtualAreaPath
$self->ivAdd('menuToolItemHash', 'view_virtual_area', $item_viewVirtualArea);
my $item_editVirtualArea = Gtk3::MenuItem->new('E_dit virtual area file...');
$item_editVirtualArea->signal_connect('activate' => sub {
# Use TRUE to specify that the virtual area file should be opened
$self->editFileCallback(TRUE);
});
$subSubMenu_sourceCode->append($item_editVirtualArea);
# (Requires $self->currentRegionmap, $self->selectedRoom &
# $self->selectedRoom->virtualAreaPath
$self->ivAdd('menuToolItemHash', 'edit_virtual_area', $item_editVirtualArea);
my $item_sourceCode = Gtk3::MenuItem->new('Source _code');
$item_sourceCode->set_submenu($subSubMenu_sourceCode);
$subMenu_roomFeatures->append($item_sourceCode);
$subMenu_roomFeatures->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setInteriorOffsets = Gtk3::MenuItem->new('_Synchronise grid coordinates...');
$item_setInteriorOffsets->signal_connect('activate' => sub {
$self->setInteriorOffsetsCallback();
});
$subMenu_roomFeatures->append($item_setInteriorOffsets);
my $item_resetInteriorOffsets = Gtk3::MenuItem->new('_Reset grid coordinates');
$item_resetInteriorOffsets->signal_connect('activate' => sub {
$self->resetInteriorOffsetsCallback();
});
$subMenu_roomFeatures->append($item_resetInteriorOffsets);
my $item_roomFeatures = Gtk3::MenuItem->new('Ot_her room features');
$item_roomFeatures->set_submenu($subMenu_roomFeatures);
$column_rooms->append($item_roomFeatures);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'other_room_features', $item_roomFeatures);
$column_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_deleteRoom = Gtk3::ImageMenuItem->new('_Delete rooms');
my $img_deleteRoom = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_deleteRoom->set_image($img_deleteRoom);
$item_deleteRoom->signal_connect('activate' => sub {
$self->deleteRoomsCallback();
});
$column_rooms->append($item_deleteRoom);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'delete_room', $item_deleteRoom);
# Setup complete
return $column_rooms;
}
sub enableExitsColumn {
# Called by $self->enableMenu
# Sets up the 'Exits' column of the Automapper window's menu bar
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Local variables
my @titleList;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableExitsColumn', @_);
}
# Set up column
my $column_exits = Gtk3::Menu->new();
if (! $column_exits) {
return undef;
}
# 'Set direction' submenu
my $subMenu_setDir = Gtk3::Menu->new();
my $item_changeDir = Gtk3::MenuItem->new('_Change direction...');
$item_changeDir->signal_connect('activate' => sub {
$self->changeDirCallback();
});
$subMenu_setDir->append($item_changeDir);
# (Requires $self->currentRegionmap and $self->selectedExit and
# $self->selectedExit->drawMode is 'primary' or 'perm_alloc')
$self->ivAdd('menuToolItemHash', 'change_direction', $item_changeDir);
my $item_altDir = Gtk3::MenuItem->new('Set _alternative direction(s)...');
$item_altDir->signal_connect('activate' => sub {
$self->setAltDirCallback();
});
$subMenu_setDir->append($item_altDir);
my $item_setDir = Gtk3::MenuItem->new('Set di_rection');
$item_setDir->set_submenu($subMenu_setDir);
$column_exits->append($item_setDir);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'set_exit_dir', $item_setDir);
my $item_setAssisted = Gtk3::MenuItem->new('Set assisted _move...');
$item_setAssisted->signal_connect('activate' => sub {
$self->setAssistedMoveCallback();
});
$column_exits->append($item_setAssisted);
# (Requires $self->currentRegionmap and $self->selectedExit and
# $self->selectedExit->drawMode is 'primary', 'temp_unalloc' or 'perm_alloc')
$self->ivAdd('menuToolItemHash', 'set_assisted_move', $item_setAssisted);
# 'Allocate map direction' submenu
my $subMenu_allocateMapDir = Gtk3::Menu->new();
my $item_allocatePrimary = Gtk3::MenuItem->new('Choose _direction...');
$item_allocatePrimary->signal_connect('activate' => sub {
$self->allocateMapDirCallback();
});
$subMenu_allocateMapDir->append($item_allocatePrimary);
my $item_confirmTwoWay = Gtk3::MenuItem->new('Confirm _two-way exit...');
$item_confirmTwoWay->signal_connect('activate' => sub {
$self->confirmTwoWayCallback();
});
$subMenu_allocateMapDir->append($item_confirmTwoWay);
my $item_allocateMapDir = Gtk3::MenuItem->new('_Allocate map direction');
$item_allocateMapDir->set_submenu($subMenu_allocateMapDir);
$column_exits->append($item_allocateMapDir);
# (Requires $self->currentRegionmap and $self->selectedExit and
# $self->selectedExit->drawMode is 'temp_alloc' or 'temp_unalloc')
$self->ivAdd('menuToolItemHash', 'allocate_map_dir', $item_allocateMapDir);
my $item_allocateShadow = Gtk3::MenuItem->new('Allocate _shadow...');
$item_allocateShadow->signal_connect('activate' => sub {
$self->allocateShadowCallback();
});
$column_exits->append($item_allocateShadow);
# (Requires $self->currentRegionmap and $self->selectedExit and
# $self->selectedExit->drawMode is 'temp_alloc' or 'temp_unalloc')
$self->ivAdd('menuToolItemHash', 'allocate_shadow', $item_allocateShadow);
$column_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_connectExitToClick = Gtk3::MenuItem->new('_Connect to click');
$item_connectExitToClick->signal_connect('activate' => sub {
$self->connectToClickCallback();
});
$column_exits->append($item_connectExitToClick);
# (Requires $self->currentRegionmap, $self->selectedExit and
# $self->selectedExit->drawMode 'primary', 'temp_unalloc' or 'perm_alloc')
$self->ivAdd('menuToolItemHash', 'connect_to_click', $item_connectExitToClick);
my $item_disconnectExit = Gtk3::MenuItem->new('D_isconnect exit');
$item_disconnectExit->signal_connect('activate' => sub {
$self->disconnectExitCallback();
});
$column_exits->append($item_disconnectExit);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'disconnect_exit', $item_disconnectExit);
$column_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Set ornaments' submenu
my $subMenu_setOrnament = Gtk3::Menu->new();
# Create a list of exit ornament types, in groups of two, in the form
# (menu_item_title, exit_ornament_type)
@titleList = (
'_No ornament', 'none',
'_Openable exit', 'open',
'_Lockable exit', 'lock',
'_Pickable exit', 'pick',
'_Breakable exit', 'break',
'_Impassable exit', 'impass',
'_Mystery exit', 'mystery',
);
do {
my ($title, $type);
$title = shift @titleList;
$type = shift @titleList;
my $menuItem = Gtk3::MenuItem->new($title);
$menuItem->signal_connect('activate' => sub {
$self->exitOrnamentCallback($type);
});
$subMenu_setOrnament->append($menuItem);
} until (! @titleList);
$subMenu_setOrnament->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setTwinOrnament = Gtk3::CheckMenuItem->new('Also set _twin exits');
$item_setTwinOrnament->set_active($self->worldModelObj->setTwinOrnamentFlag);
$item_setTwinOrnament->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'setTwinOrnamentFlag',
$item_setTwinOrnament->get_active(),
FALSE, # Don't call $self->redrawRegions
'also_set_twin_exits',
);
}
});
$subMenu_setOrnament->append($item_setTwinOrnament);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'also_set_twin_exits', $item_setTwinOrnament);
my $item_setOrnament = Gtk3::MenuItem->new('Set _ornaments');
$item_setOrnament->set_submenu($subMenu_setOrnament);
$column_exits->append($item_setOrnament);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'set_ornament_sub', $item_setOrnament);
# 'Set exit type' submenu
my $subMenu_setExitType = Gtk3::Menu->new();
# 'Set hidden' sub-submenu
my $subSubMenu_setHidden = Gtk3::Menu->new();
my $item_setHiddenExit = Gtk3::MenuItem->new('Mark exit _hidden');
$item_setHiddenExit->signal_connect('activate' => sub {
$self->hiddenExitCallback(TRUE);
});
$subSubMenu_setHidden->append($item_setHiddenExit);
my $item_setNotHiddenExit = Gtk3::MenuItem->new('Mark exit _not hidden');
$item_setNotHiddenExit->signal_connect('activate' => sub {
$self->hiddenExitCallback(FALSE);
});
$subSubMenu_setHidden->append($item_setNotHiddenExit);
my $item_setHidden = Gtk3::MenuItem->new('Set _hidden');
$item_setHidden->set_submenu($subSubMenu_setHidden);
$subMenu_setExitType->append($item_setHidden);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'set_hidden_sub', $item_setHidden);
# 'Set broken' sub-submenu
my $subSubMenu_setBroken = Gtk3::Menu->new();
my $item_markBrokenExit = Gtk3::MenuItem->new('_Mark exit as broken');
$item_markBrokenExit->signal_connect('activate' => sub {
$self->markBrokenExitCallback();
});
$subSubMenu_setBroken->append($item_markBrokenExit);
my $item_toggleBrokenExit = Gtk3::MenuItem->new('_Toggle bent broken exit');
$item_toggleBrokenExit->signal_connect('activate' => sub {
$self->worldModelObj->toggleBentExit(
TRUE, # Update Automapper windows now
$self->selectedExit,
);
});
$subSubMenu_setBroken->append($item_toggleBrokenExit);
# (Requires $self->currentRegionmap and a $self->selectedExit which is a broken
# exit)
$self->ivAdd('menuToolItemHash', 'toggle_bent_exit', $item_toggleBrokenExit);
$subSubMenu_setBroken->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_restoreBrokenExit = Gtk3::MenuItem->new('_Restore unbroken exit');
$item_restoreBrokenExit->signal_connect('activate' => sub {
$self->restoreBrokenExitCallback();
});
$subSubMenu_setBroken->append($item_restoreBrokenExit);
my $item_setBroken = Gtk3::MenuItem->new('Set _broken');
$item_setBroken->set_submenu($subSubMenu_setBroken);
$subMenu_setExitType->append($item_setBroken);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'set_broken_sub', $item_setBroken);
# 'Set one-way' sub-submenu
my $subSubMenu_setOneWay = Gtk3::Menu->new();
my $item_markOneWayExit = Gtk3::MenuItem->new('_Mark exit as one-way');
$item_markOneWayExit->signal_connect('activate' => sub {
$self->markOneWayExitCallback();
});
$subSubMenu_setOneWay->append($item_markOneWayExit);
$subSubMenu_setOneWay->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_restoreUncertainExit = Gtk3::MenuItem->new('Restore _uncertain exit');
$item_restoreUncertainExit->signal_connect('activate' => sub {
$self->restoreOneWayExitCallback(FALSE);
});
$subSubMenu_setOneWay->append($item_restoreUncertainExit);
my $item_restoreTwoWayExit = Gtk3::MenuItem->new('Restore _two-way exit');
$item_restoreTwoWayExit->signal_connect('activate' => sub {
$self->restoreOneWayExitCallback(TRUE);
});
$subSubMenu_setOneWay->append($item_restoreTwoWayExit);
$subSubMenu_setOneWay->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setIncomingDir = Gtk3::MenuItem->new('Set incoming _direction...');
$item_setIncomingDir->signal_connect('activate' => sub {
$self->setIncomingDirCallback();
});
$subSubMenu_setOneWay->append($item_setIncomingDir);
# (Requires $self->currentRegionmap and a $self->selectedExit which is a one-way
# exit)
$self->ivAdd('menuToolItemHash', 'set_incoming_dir', $item_setIncomingDir);
my $item_setOneWay = Gtk3::MenuItem->new('Set _one-way');
$item_setOneWay->set_submenu($subSubMenu_setOneWay);
$subMenu_setExitType->append($item_setOneWay);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'set_oneway_sub', $item_setOneWay);
# 'Set retracing' sub-submenu
my $subSubMenu_setRetracing = Gtk3::Menu->new();
my $item_markRetracingExit = Gtk3::MenuItem->new('_Mark exit as retracing');
$item_markRetracingExit->signal_connect('activate' => sub {
$self->markRetracingExitCallback();
});
$subSubMenu_setRetracing->append($item_markRetracingExit);
$subSubMenu_setRetracing->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_restoreRetracingExit = Gtk3::MenuItem->new('_Restore incomplete exit');
$item_restoreRetracingExit->signal_connect('activate' => sub {
$self->restoreRetracingExitCallback();
});
$subSubMenu_setRetracing->append($item_restoreRetracingExit);
my $item_setRetracing = Gtk3::MenuItem->new('Set _retracing');
$item_setRetracing->set_submenu($subSubMenu_setRetracing);
$subMenu_setExitType->append($item_setRetracing);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'set_retracing_sub', $item_setRetracing);
# 'Set random' sub-submenu
my $subSubMenu_setRandomExit = Gtk3::Menu->new();
my $item_markRandomRegion = Gtk3::MenuItem->new(
'Set random destination in same _region',
);
$item_markRandomRegion->signal_connect('activate' => sub {
$self->markRandomExitCallback('same_region');
});
$subSubMenu_setRandomExit->append($item_markRandomRegion);
my $item_markRandomAnywhere
= Gtk3::MenuItem->new('Set random destination _anywhere');
$item_markRandomAnywhere->signal_connect('activate' => sub {
$self->markRandomExitCallback('any_region');
});
$subSubMenu_setRandomExit->append($item_markRandomAnywhere);
my $item_randomTempRegion
= Gtk3::MenuItem->new('_Create destination in temporary region');
$item_randomTempRegion->signal_connect('activate' => sub {
$self->markRandomExitCallback('temp_region');
});
$subSubMenu_setRandomExit->append($item_randomTempRegion);
my $item_markRandomList = Gtk3::MenuItem->new('_Use list of random destinations');
$item_markRandomList->signal_connect('activate' => sub {
$self->markRandomExitCallback('room_list');
});
$subSubMenu_setRandomExit->append($item_markRandomList);
$subSubMenu_setRandomExit->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_restoreRandomExit = Gtk3::MenuItem->new('Restore _incomplete exit');
$item_restoreRandomExit->signal_connect('activate' => sub {
$self->restoreRandomExitCallback();
});
$subSubMenu_setRandomExit->append($item_restoreRandomExit);
my $item_setRandomExit = Gtk3::MenuItem->new('Set r_andom');
$item_setRandomExit->set_submenu($subSubMenu_setRandomExit);
$subMenu_setExitType->append($item_setRandomExit);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'set_random_sub', $item_setRandomExit);
# 'Set super' sub-submenu
my $subSubMenu_setSuperExit = Gtk3::Menu->new();
my $item_markSuper = Gtk3::MenuItem->new('Mark exit as _super-region exit');
$item_markSuper->signal_connect('activate' => sub {
$self->markSuperExitCallback(FALSE);
});
$subSubMenu_setSuperExit->append($item_markSuper);
my $item_markSuperExcl = Gtk3::MenuItem->new(
'Mark exit as _exclusive super-region exit',
);
$item_markSuperExcl->signal_connect('activate' => sub {
$self->markSuperExitCallback(TRUE);
});
$subSubMenu_setSuperExit->append($item_markSuperExcl);
$subSubMenu_setSuperExit->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_markNotSuper = Gtk3::MenuItem->new('Mark exit as _normal region exit');
$item_markNotSuper->signal_connect('activate' => sub {
$self->restoreSuperExitCallback();
});
$subSubMenu_setSuperExit->append($item_markNotSuper);
my $item_setSuperExit = Gtk3::MenuItem->new('Set _super');
$item_setSuperExit->set_submenu($subSubMenu_setSuperExit);
$subMenu_setExitType->append($item_setSuperExit);
# (Requires $self->currentRegionmap and $self->selectedExit which is a region exit)
$self->ivAdd('menuToolItemHash', 'set_super_sub', $item_setSuperExit);
$subMenu_setExitType->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setExitTwin = Gtk3::MenuItem->new('Set exit _twin...');
$item_setExitTwin->signal_connect('activate' => sub {
$self->setExitTwinCallback();
});
$subMenu_setExitType->append($item_setExitTwin);
# (Requires $self->currentRegionmap and a $self->selectedExit which is either a one-way
# exit or an uncertain exit)
$self->ivAdd('menuToolItemHash', 'set_exit_twin', $item_setExitTwin);
my $item_setExitType = Gtk3::MenuItem->new('Set _exit type');
$item_setExitType->set_submenu($subMenu_setExitType);
$column_exits->append($item_setExitType);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'set_exit_type', $item_setExitType);
# 'Exit tags' submenu
my $subMenu_exitTags = Gtk3::Menu->new();
my $item_setExitText = Gtk3::MenuItem->new('_Edit tag text');
$item_setExitText->signal_connect('activate' => sub {
$self->editExitTagCallback();
});
$subMenu_exitTags->append($item_setExitText);
# (Requires $self->currentRegionmap and either a $self->selectedExit which is a region
# exit, or a $self->selectedExitTag)
$self->ivAdd('menuToolItemHash', 'edit_tag_text', $item_setExitText);
my $item_toggleExitTag = Gtk3::MenuItem->new('_Toggle exit tag');
$item_toggleExitTag->signal_connect('activate' => sub {
$self->toggleExitTagCallback();
});
$subMenu_exitTags->append($item_toggleExitTag);
# (Requires $self->currentRegionmap and either a $self->selectedExit which is a region
# exit, or a $self->selectedExitTag)
$self->ivAdd('menuToolItemHash', 'toggle_exit_tag', $item_toggleExitTag);
$subMenu_exitTags->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_resetPositions = Gtk3::MenuItem->new('_Reset tag positions');
$item_resetPositions->signal_connect('activate' => sub {
$self->resetExitOffsetsCallback();
});
$subMenu_exitTags->append($item_resetPositions);
# (Requires $self->currentRegionmap and one or more of $self->selectedExit,
# $self->selectedExitHash, $self->selectedExitTag and $self->selectedExitTagHash)
$self->ivAdd('menuToolItemHash', 'reset_exit_tags', $item_resetPositions);
$subMenu_exitTags->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_applyExitTags = Gtk3::MenuItem->new('_Apply all tags in region');
$item_applyExitTags->signal_connect('activate' => sub {
$self->applyExitTagsCallback(TRUE);
});
$subMenu_exitTags->append($item_applyExitTags);
my $item_cancelExitTags = Gtk3::MenuItem->new('_Cancel all tags in region');
$item_cancelExitTags->signal_connect('activate' => sub {
$self->applyExitTagsCallback(FALSE);
});
$subMenu_exitTags->append($item_cancelExitTags);
my $item_exitTags = Gtk3::MenuItem->new('Exit _tags');
$item_exitTags->set_submenu($subMenu_exitTags);
$column_exits->append($item_exitTags);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'exit_tags', $item_exitTags);
$column_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editExit = Gtk3::ImageMenuItem->new('Edit e_xit...');
my $img_editExit = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editExit->set_image($img_editExit);
$item_editExit->signal_connect('activate' => sub {
$self->editExitCallback();
});
$column_exits->append($item_editExit);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'edit_exit', $item_editExit);
$column_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Exit options' submenu
my $subMenu_exitOptions = Gtk3::Menu->new();
my $item_completeSelected = Gtk3::MenuItem->new('_Complete selected uncertain exits');
$item_completeSelected->signal_connect('activate' => sub {
$self->completeExitsCallback();
});
$subMenu_exitOptions->append($item_completeSelected);
my $item_connectAdjacent = Gtk3::MenuItem->new('C_onnect selected adjacent rooms');
$item_connectAdjacent->signal_connect('activate' => sub {
$self->connectAdjacentCallback();
});
$subMenu_exitOptions->append($item_connectAdjacent);
# (Requires $self->currentRegionmap and one or more selected rooms)
$self->ivAdd('menuToolItemHash', 'connect_adjacent', $item_connectAdjacent);
$subMenu_exitOptions->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_autocomplete = Gtk3::CheckMenuItem->new('_Autocomplete uncertain exits');
$item_autocomplete->set_active($self->worldModelObj->autocompleteExitsFlag);
$item_autocomplete->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'autocompleteExitsFlag',
$item_autocomplete->get_active(),
FALSE, # Don't call $self->redrawRegions
'autcomplete_uncertain',
);
}
});
$subMenu_exitOptions->append($item_autocomplete);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'autocomplete_uncertain', $item_autocomplete);
my $item_intUncertain = Gtk3::CheckMenuItem->new('_Intelligent uncertain exits');
$item_intUncertain->set_active(
$self->worldModelObj->intelligentExitsFlag,
);
$item_intUncertain->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'intelligentExitsFlag',
$item_intUncertain->get_active(),
FALSE, # Don't call $self->redrawRegions
'intelligent_uncertain',
);
}
});
$subMenu_exitOptions->append($item_intUncertain);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'intelligent_uncertain', $item_intUncertain);
$subMenu_exitOptions->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_collectChecked = Gtk3::CheckMenuItem->new('Co_llect checked directions');
$item_collectChecked->set_active(
$self->worldModelObj->collectCheckedDirsFlag,
);
$item_collectChecked->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'collectCheckedDirsFlag',
$item_collectChecked->get_active(),
FALSE, # Don't call $self->redrawRegions
'collect_checked_dirs',
);
}
});
$subMenu_exitOptions->append($item_collectChecked);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'collect_checked_dirs', $item_collectChecked);
my $item_drawChecked = Gtk3::CheckMenuItem->new('_Draw checked directions');
$item_drawChecked->set_active(
$self->worldModelObj->drawCheckedDirsFlag,
);
$item_drawChecked->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'drawCheckedDirsFlag',
$item_drawChecked->get_active(),
FALSE, # Don't call $self->redrawRegions
'draw_checked_dirs',
);
}
# Redraw the region, if one is visible
if ($self->currentRegionmap) {
$self->redrawRegions();
}
});
$subMenu_exitOptions->append($item_drawChecked);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'draw_checked_dirs', $item_drawChecked);
$subMenu_exitOptions->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Checkable directions' sub-submenu
my $subSubMenu_checkable = Gtk3::Menu->new();
my $item_checkableSimple
= Gtk3::RadioMenuItem->new_with_mnemonic(undef, 'Count _NSEW');
$item_checkableSimple->signal_connect('toggled' => sub {
if ($item_checkableSimple->get_active) {
$self->worldModelObj->setCheckableDirMode('simple');
}
});
my $item_checkableGroup = $item_checkableSimple->get_group();
$subSubMenu_checkable->append($item_checkableSimple);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'checkable_dir_simple', $item_checkableSimple);
my $item_checkableDiku = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_checkableGroup,
'Count NSEW_UD',
);
if ($self->worldModelObj->checkableDirMode eq 'diku') {
$item_checkableDiku->set_active(TRUE);
}
$item_checkableDiku->signal_connect('toggled' => sub {
if ($item_checkableDiku->get_active) {
$self->worldModelObj->setCheckableDirMode('diku');
}
});
$subSubMenu_checkable->append($item_checkableDiku);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'checkable_dir_diku', $item_checkableDiku);
my $item_checkableLP = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_checkableGroup,
'Count NSEWUD, N_E/NW/SE/SW',
);
if ($self->worldModelObj->checkableDirMode eq 'lp') {
$item_checkableLP->set_active(TRUE);
}
$item_checkableLP->signal_connect('toggled' => sub {
if ($item_checkableLP->get_active) {
$self->worldModelObj->setCheckableDirMode('lp');
}
});
$subSubMenu_checkable->append($item_checkableLP);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'checkable_dir_lp', $item_checkableLP);
my $item_checkableComplex = Gtk3::RadioMenuItem->new_with_mnemonic(
$item_checkableGroup,
'Count _all primary directions',
);
if ($self->worldModelObj->checkableDirMode eq 'complex') {
$item_checkableComplex->set_active(TRUE);
}
$item_checkableComplex->signal_connect('toggled' => sub {
if ($item_checkableComplex->get_active) {
$self->worldModelObj->setCheckableDirMode('complex');
}
});
$subSubMenu_checkable->append($item_checkableComplex);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'checkable_dir_complex', $item_checkableComplex);
my $item_exits = Gtk3::MenuItem->new('C_heckable directions');
$item_exits->set_submenu($subSubMenu_checkable);
$subMenu_exitOptions->append($item_exits);
my $item_exitOptions = Gtk3::MenuItem->new('Exit o_ptions');
$item_exitOptions->set_submenu($subMenu_exitOptions);
$column_exits->append($item_exitOptions);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'exit_options', $item_exitOptions);
# 'Exit lengths' submenu
my $subMenu_exitLengths = Gtk3::Menu->new();
my $item_horizontalLength = Gtk3::MenuItem->new('Set _horizontal length...');
$item_horizontalLength->signal_connect('activate' => sub {
$self->setExitLengthCallback('horizontal');
});
$subMenu_exitLengths->append($item_horizontalLength);
my $item_verticalLength = Gtk3::MenuItem->new('Set _vertical length...');
$item_verticalLength->signal_connect('activate' => sub {
$self->setExitLengthCallback('vertical');
});
$subMenu_exitLengths->append($item_verticalLength);
$subMenu_exitLengths->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_resetLength = Gtk3::MenuItem->new('_Reset exit lengths');
$item_resetLength->signal_connect('activate' => sub {
$self->resetExitLengthCallback();
});
$subMenu_exitLengths->append($item_resetLength);
my $item_exitLengths = Gtk3::MenuItem->new('Exit _lengths');
$item_exitLengths->set_submenu($subMenu_exitLengths);
$column_exits->append($item_exitLengths);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'exit_lengths', $item_exitLengths);
$column_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_deleteExit = Gtk3::ImageMenuItem->new('_Delete exit');
my $img_deleteExit = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_deleteExit->set_image($img_deleteExit);
$item_deleteExit->signal_connect('activate' => sub {
$self->deleteExitCallback();
});
$column_exits->append($item_deleteExit);
# (Requires $self->currentRegionmap and $self->selectedExit)
$self->ivAdd('menuToolItemHash', 'delete_exit', $item_deleteExit);
# Setup complete
return $column_exits;
}
sub enableLabelsColumn {
# Called by $self->enableMenu
# Sets up the 'Labels' column of the Automapper window's menu bar
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Local variables
my $alignFlag;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableLabelsColumn', @_);
}
# Set up column
my $column_labels = Gtk3::Menu->new();
if (! $column_labels) {
return undef;
}
my $item_addLabelAtClick = Gtk3::ImageMenuItem->new('Add label at _click');
my $img_addLabelAtClick = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_addLabelAtClick->set_image($img_addLabelAtClick);
$item_addLabelAtClick->signal_connect('activate' => sub {
# Set the free click mode; $self->canvasEventHandler will create the new label when the
# user next clicks on an empty part of the map
if ($self->currentRegionmap) {
$self->set_freeClickMode('add_label');
}
});
$column_labels->append($item_addLabelAtClick);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'add_label_at_click', $item_addLabelAtClick);
my $item_addLabelAtBlock = Gtk3::ImageMenuItem->new('Add label at _block');
my $img_addLabelAtBlock = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_addLabelAtBlock->set_image($img_addLabelAtBlock);
$item_addLabelAtBlock->signal_connect('activate' => sub {
$self->addLabelAtBlockCallback();
});
$column_labels->append($item_addLabelAtBlock);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'add_label_at_block', $item_addLabelAtBlock);
$column_labels->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setLabel = Gtk3::ImageMenuItem->new('_Set label...');
my $img_setLabel = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_setLabel->set_image($img_setLabel);
$item_setLabel->signal_connect('activate' => sub {
$self->setLabelCallback(FALSE);
});
$column_labels->append($item_setLabel);
# (Requires $self->currentRegionmap and $self->selectedLabel)
$self->ivAdd('menuToolItemHash', 'set_label', $item_setLabel);
my $item_customiseLabel = Gtk3::ImageMenuItem->new('C_ustomise label...');
my $img_customiseLabel = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_customiseLabel->set_image($img_customiseLabel);
$item_customiseLabel->signal_connect('activate' => sub {
$self->setLabelCallback(TRUE);
});
$column_labels->append($item_customiseLabel);
# (Requires $self->currentRegionmap and $self->selectedLabel)
$self->ivAdd('menuToolItemHash', 'customise_label', $item_customiseLabel);
my $item_useMultiLine = Gtk3::CheckMenuItem->new('Use _multiline labels');
$item_useMultiLine->set_active($self->worldModelObj->mapLabelTextViewFlag);
$item_useMultiLine->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'mapLabelTextViewFlag',
$item_useMultiLine->get_active(),
FALSE, # Don't call $self->redrawRegions
'use_multi_line',
);
}
});
$column_labels->append($item_useMultiLine);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'use_multi_line', $item_useMultiLine);
$column_labels->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_selectLabel = Gtk3::MenuItem->new('S_elect label...');
$item_selectLabel->signal_connect('activate' => sub {
$self->selectLabelCallback();
});
$column_labels->append($item_selectLabel);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'select_label', $item_selectLabel);
$column_labels->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addStyle = Gtk3::ImageMenuItem->new('_Add label style...');
my $img_addStyle = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_addStyle->set_image($img_addStyle);
$item_addStyle->signal_connect('activate' => sub {
$self->addStyleCallback();
});
$column_labels->append($item_addStyle);
my $item_editStyle = Gtk3::ImageMenuItem->new('Ed_it label style...');
my $img_editStyle = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editStyle->set_image($img_editStyle);
$item_editStyle->signal_connect('activate' => sub {
$self->editStyleCallback();
});
$column_labels->append($item_editStyle);
# (Requires at least one label style in $self->worldModelObj->mapLabelStyleHash)
$self->ivAdd('menuToolItemHash', 'edit_style', $item_selectLabel);
# 'Label alignment' submenu
my $subMenu_alignment = Gtk3::Menu->new();
my $item_alignHorizontal = Gtk3::CheckMenuItem->new('Align _horizontally');
$item_alignHorizontal->set_active($self->worldModelObj->mapLabelAlignXFlag);
$item_alignHorizontal->signal_connect('toggled' => sub {
# Use $alignFlag to avoid an infinite loop, if we have to toggle the button back to
# its original state because the user declined to confirm the operation
if (! $alignFlag) {
if (! $self->toggleAlignCallback('horizontal')) {
$alignFlag = TRUE;
if (! $item_alignHorizontal->get_active()) {
$item_alignHorizontal->set_active(TRUE);
} else {
$item_alignHorizontal->set_active(FALSE);
}
$alignFlag = FALSE;
}
}
});
$subMenu_alignment->append($item_alignHorizontal);
my $item_alignVertical = Gtk3::CheckMenuItem->new('Align _vertically');
$item_alignVertical->set_active($self->worldModelObj->mapLabelAlignYFlag);
$item_alignVertical->signal_connect('toggled' => sub {
# Use $alignFlag to avoid an infinite loop, if we have to toggle the button back to
# its original state because the user declined to confirm the operation
if (! $alignFlag) {
if (! $self->toggleAlignCallback('vertical')) {
$alignFlag = TRUE;
if (! $item_alignVertical->get_active()) {
$item_alignVertical->set_active(TRUE);
} else {
$item_alignVertical->set_active(FALSE);
}
$alignFlag = FALSE;
}
}
});
$subMenu_alignment->append($item_alignVertical);
my $item_alignment = Gtk3::MenuItem->new('_Label alignment');
$item_alignment->set_submenu($subMenu_alignment);
$column_labels->append($item_alignment);
$column_labels->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_deleteLabel = Gtk3::ImageMenuItem->new('_Delete labels');
my $img_deleteLabel = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_deleteLabel->set_image($img_deleteLabel);
$item_deleteLabel->signal_connect('activate' => sub {
# Callback to prompt for confirmation, before deleting multiple labels
$self->deleteLabelsCallback();
});
$column_labels->append($item_deleteLabel);
# (Requires $self->currentRegionmap & either $self->selectedLabel or
# $self->selectedLabelHash)
$self->ivAdd('menuToolItemHash', 'delete_label', $item_deleteLabel);
my $item_quickDelete = Gtk3::ImageMenuItem->new('_Quick label deletion...');
my $img_quickDelete = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_quickDelete->set_image($img_quickDelete);
$item_quickDelete->signal_connect('activate' => sub {
$self->session->pseudoCmd('quicklabeldelete', $self->pseudoCmdMode);
});
$column_labels->append($item_quickDelete);
# Setup complete
return $column_labels;
}
# Popup menu widget methods
sub enableCanvasPopupMenu {
# Called by $self->canvasEventHandler
# Creates a popup-menu for the Gtk3::Canvas when no rooms, exits, room tags or labels are
# selected
#
# Expected arguments
# $clickXPosPixels, $clickYPosPixels
# - Coordinates of the pixel that was right-clicked on the map
# $clickXPosBlocks, $clickYPosBlocks
# - Coordinates of the gridblock that was right-clicked on the map
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my (
$self, $clickXPosPixels, $clickYPosPixels, $clickXPosBlocks, $clickYPosBlocks, $check,
) = @_;
# Check for improper arguments
if (
! defined $clickXPosPixels || ! defined $clickYPosPixels
|| ! defined $clickXPosBlocks || ! defined $clickYPosBlocks || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableCanvasPopupMenu', @_);
}
# Set up the popup menu
my $menu_canvas = Gtk3::Menu->new();
if (! $menu_canvas) {
return undef;
}
# (Everything here assumes $self->currentRegionmap)
my $item_addFirstRoom = Gtk3::ImageMenuItem->new('Add _first room');
my $img_addFirstRoom = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_addFirstRoom->set_image($img_addFirstRoom);
$item_addFirstRoom->signal_connect('activate' => sub {
$self->addFirstRoomCallback();
});
$menu_canvas->append($item_addFirstRoom);
# (Also requires empty $self->currentRegionmap->gridRoomHash)
if ($self->currentRegionmap->gridRoomHash) {
$item_addFirstRoom->set_sensitive(FALSE);
}
my $item_addRoomHere = Gtk3::ImageMenuItem->new('Add _room here');
my $img_addRoomHere = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_addRoomHere->set_image($img_addRoomHere);
$item_addRoomHere->signal_connect('activate' => sub {
my $roomObj;
# The 'Add room at click' operation from the main menu resets the value of
# ->freeClickMode; we must do the same here
$self->reset_freeClickMode();
# Create the room
$roomObj = $self->mapObj->createNewRoom(
$self->currentRegionmap,
$clickXPosBlocks,
$clickYPosBlocks,
$self->currentRegionmap->currentLevel,
);
# When using the 'Add room at block' menu item, the new room is selected to make it
# easier to see where it was drawn. To make things consistent, select this new room,
# too
if ($roomObj) {
$self->setSelectedObj(
[$roomObj, 'room'],
FALSE, # Select this object; unselect all other objects
);
}
});
$menu_canvas->append($item_addRoomHere);
$menu_canvas->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addLabelHere = Gtk3::ImageMenuItem->new('Add _label here');
my $img_addLabelHere = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_addLabelHere->set_image($img_addLabelHere);
$item_addLabelHere->signal_connect('activate' => sub {
$self->addLabelAtClickCallback($clickXPosPixels, $clickYPosPixels);
});
$menu_canvas->append($item_addLabelHere);
$menu_canvas->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_centreMap = Gtk3::MenuItem->new('_Centre map here');
$item_centreMap->signal_connect('activate' => sub {
$self->centreMapOverRoom(
undef, # Centre the map, not over a room...
$clickXPosBlocks, # ...but over this gridblock
$clickYPosBlocks,
);
});
$menu_canvas->append($item_centreMap);
$menu_canvas->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editRegionmap = Gtk3::ImageMenuItem->new('_Edit regionmap...');
my $img_editRegionmap = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editRegionmap->set_image($img_editRegionmap);
$item_editRegionmap->signal_connect('activate' => sub {
# Open an 'edit' window for the regionmap
$self->createFreeWin(
'Games::Axmud::EditWin::Regionmap',
$self,
$self->session,
'Edit \'' . $self->currentRegionmap->name . '\' regionmap',
$self->currentRegionmap,
FALSE, # Not temporary
);
});
$menu_canvas->append($item_editRegionmap);
my $item_preferences = Gtk3::ImageMenuItem->new('Edit world _model...');
my $img_preferences = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_preferences->set_image($img_preferences);
$item_preferences->signal_connect('activate' => sub {
# Open an 'edit' window for the world model
$self->createFreeWin(
'Games::Axmud::EditWin::WorldModel',
$self,
$self->session,
'Edit world model',
$self->session->worldModelObj,
FALSE, # Not temporary
);
});
$menu_canvas->append($item_preferences);
# Setup complete
$menu_canvas->show_all();
return $menu_canvas;
}
sub enableRoomsPopupMenu {
# Called by $self->canvasObjEventHandler
# Creates a popup-menu for the selected room
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableRoomsPopupMenu', @_);
}
# Set up the popup menu
my $menu_rooms = Gtk3::Menu->new();
if (! $menu_rooms) {
return undef;
}
# (Everything here assumes $self->currentRegionmap and $self->selectedRoom)
my $item_setCurrentRoom = Gtk3::MenuItem->new('_Set current room');
$item_setCurrentRoom->signal_connect('activate' => sub {
$self->mapObj->setCurrentRoom($self->selectedRoom);
});
$menu_rooms->append($item_setCurrentRoom);
my $item_centreMap = Gtk3::MenuItem->new('_Centre map over room');
$item_centreMap->signal_connect('activate' => sub {
$self->centreMapOverRoom($self->selectedRoom);
});
$menu_rooms->append($item_centreMap);
my $item_executeScripts = Gtk3::MenuItem->new('Run _Axbasic scripts');
$item_executeScripts->signal_connect('activate' => sub {
$self->executeScriptsCallback();
});
$menu_rooms->append($item_executeScripts);
# (Also requires $self->mapObj->currentRoom that's the same as $self->selectedRoom)
if (! $self->mapObj->currentRoom || $self->mapObj->currentRoom ne $self->selectedRoom) {
$item_executeScripts->set_sensitive(FALSE);
}
$menu_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Pathfinding' submenu
my $subMenu_pathFinding = Gtk3::Menu->new();
my $item_highlightPath = Gtk3::MenuItem->new('_Highlight path');
$item_highlightPath->signal_connect('activate' => sub {
$self->processPathCallback('select_room');
});
$subMenu_pathFinding->append($item_highlightPath);
my $item_displayPath = Gtk3::MenuItem->new('_Edit path...');
$item_displayPath->signal_connect('activate' => sub {
$self->processPathCallback('pref_win');
});
$subMenu_pathFinding->append($item_displayPath);
my $item_goToRoom = Gtk3::MenuItem->new('_Go to room');
$item_goToRoom->signal_connect('activate' => sub {
$self->processPathCallback('send_char');
});
$subMenu_pathFinding->append($item_goToRoom);
my $item_pathFinding = Gtk3::MenuItem->new('_Pathfinding');
$item_pathFinding->set_submenu($subMenu_pathFinding);
$menu_rooms->append($item_pathFinding);
# (Also requires $self->mapObj->currentRoom)
if (! $self->mapObj->currentRoom) {
$item_pathFinding->set_sensitive(FALSE);
}
# 'Moves rooms/labels' submenu
my $subMenu_moveRooms = Gtk3::Menu->new();
my $item_moveSelected = Gtk3::MenuItem->new('Move in _direction...');
$item_moveSelected->signal_connect('activate' => sub {
$self->moveSelectedRoomsCallback();
});
$subMenu_moveRooms->append($item_moveSelected);
my $item_moveSelectedToClick = Gtk3::MenuItem->new('Move to _click');
$item_moveSelectedToClick->signal_connect('activate' => sub {
# Set the free clicking mode: $self->mouseClickEvent will move the objects when the
# user next clicks on an empty part of the map
$self->set_freeClickMode('move_room');
});
$subMenu_moveRooms->append($item_moveSelectedToClick);
$subMenu_moveRooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Transfer to region' sub-submenu
my $subSubMenu_transferRegion = Gtk3::Menu->new();
if ($self->recentRegionList) {
foreach my $name ($self->recentRegionList) {
my $item_regionName = Gtk3::MenuItem->new($name);
$item_regionName->signal_connect('activate' => sub {
$self->transferSelectedRoomsCallback($name);
});
$subSubMenu_transferRegion->append($item_regionName);
}
} else {
my $item_regionNone = Gtk3::MenuItem->new('(No recent regions)');
$item_regionNone->set_sensitive(FALSE);
$subSubMenu_transferRegion->append($item_regionNone);
}
$subSubMenu_transferRegion->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_transferSelect = Gtk3::MenuItem->new('Select region...');
$item_transferSelect->signal_connect('activate' => sub {
$self->transferSelectedRoomsCallback();
});
$subSubMenu_transferRegion->append($item_transferSelect);
my $item_transferRegion = Gtk3::MenuItem->new('_Transfer to region');
$item_transferRegion->set_submenu($subSubMenu_transferRegion);
$subMenu_moveRooms->append($item_transferRegion);
# (Also requires at least two regions in the world model)
if ($self->worldModelObj->ivPairs('regionmapHash') <= 1) {
$item_transferRegion->set_sensitive(FALSE);
}
$subMenu_moveRooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_mergeRoom = Gtk3::MenuItem->new('_Merge room');
$item_mergeRoom->signal_connect('activate' => sub {
$self->doMerge($self->mapObj->currentRoom);
});
$subMenu_moveRooms->append($item_mergeRoom);
# (Also requires this to be the current room and the automapper being set up to perform
# a merge)
if (
! $self->mapObj->currentRoom
|| $self->mapObj->currentRoom ne $self->selectedRoom
|| ! $self->mapObj->currentMatchFlag
) {
$item_mergeRoom->set_sensitive(FALSE);
}
# 'Compare room' sub-submenu
my $subSubMenu_compareRoom = Gtk3::Menu->new();
my $item_compareRoomRegion = Gtk3::MenuItem->new('...with rooms in region');
$item_compareRoomRegion->signal_connect('activate' => sub {
$self->compareRoomCallback(FALSE);
});
$subSubMenu_compareRoom->append($item_compareRoomRegion);
my $item_compareRoomModel = Gtk3::MenuItem->new('...with rooms in whole world');
$item_compareRoomModel->signal_connect('activate' => sub {
$self->compareRoomCallback(TRUE);
});
$subSubMenu_compareRoom->append($item_compareRoomModel);
my $item_compareRoom = Gtk3::MenuItem->new('_Compare room');
$item_compareRoom->set_submenu($subSubMenu_compareRoom);
$subMenu_moveRooms->append($item_compareRoom);
my $item_moveRooms = Gtk3::MenuItem->new('_Move rooms/labels');
$item_moveRooms->set_submenu($subMenu_moveRooms);
$menu_rooms->append($item_moveRooms);
# 'Add pattern' submenu
my $subMenu_exitPatterns = Gtk3::Menu->new();
my $item_addFailedExitRoom = Gtk3::MenuItem->new('Add _failed exit...');
$item_addFailedExitRoom->signal_connect('activate' => sub {
$self->addFailedExitCallback(FALSE, $self->selectedRoom);
});
$subMenu_exitPatterns->append($item_addFailedExitRoom);
$subMenu_exitPatterns->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addInvoluntaryExitRoom = Gtk3::MenuItem->new('Add _involuntary exit...');
$item_addInvoluntaryExitRoom->signal_connect('activate' => sub {
$self->addInvoluntaryExitCallback($self->selectedRoom);
});
$subMenu_exitPatterns->append($item_addInvoluntaryExitRoom);
my $item_addRepulseExitRoom = Gtk3::MenuItem->new('Add _repulse exit...');
$item_addRepulseExitRoom->signal_connect('activate' => sub {
$self->addRepulseExitCallback($self->selectedRoom);
});
$subMenu_exitPatterns->append($item_addRepulseExitRoom);
$subMenu_exitPatterns->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addSpecialDepartRoom = Gtk3::MenuItem->new('Add _special departure...');
$item_addSpecialDepartRoom->signal_connect('activate' => sub {
$self->addSpecialDepartureCallback($self->selectedRoom);
});
$subMenu_exitPatterns->append($item_addSpecialDepartRoom);
my $item_addUnspecifiedRoom = Gtk3::MenuItem->new('Add _unspecified room pattern...');
$item_addUnspecifiedRoom->signal_connect('activate' => sub {
$self->addUnspecifiedPatternCallback($self->selectedRoom);
});
$subMenu_exitPatterns->append($item_addUnspecifiedRoom);
$menu_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_patterns = Gtk3::MenuItem->new('Add pa_ttern');
$item_patterns->set_submenu($subMenu_exitPatterns);
$menu_rooms->append($item_patterns);
# 'Add to model' submenu
my $subMenu_addToModel = Gtk3::Menu->new();
my $item_addRoomContents = Gtk3::MenuItem->new('Add _contents...');
$item_addRoomContents->signal_connect('activate' => sub {
$self->addContentsCallback(FALSE);
});
$subMenu_addToModel->append($item_addRoomContents);
# (Also requires $self->mapObj->currentRoom that's the same as $self->selectedRoom
if (! $self->mapObj->currentRoom || $self->mapObj->currentRoom ne $self->selectedRoom) {
$item_addRoomContents->set_sensitive(FALSE);
}
my $item_addContentsString = Gtk3::MenuItem->new('Add c_ontents from string...');
$item_addContentsString->signal_connect('activate' => sub {
$self->addContentsCallback(TRUE);
});
$subMenu_addToModel->append($item_addContentsString);
$subMenu_addToModel->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addHiddenObj = Gtk3::MenuItem->new('Add _hidden object...');
$item_addHiddenObj->signal_connect('activate' => sub {
$self->addHiddenObjCallback(FALSE);
});
$subMenu_addToModel->append($item_addHiddenObj);
# (Also requires $self->mapObj->currentRoom that's the same as $self->selectedRoom
if (! $self->mapObj->currentRoom || $self->mapObj->currentRoom ne $self->selectedRoom) {
$item_addHiddenObj->set_sensitive(FALSE);
}
my $item_addHiddenString = Gtk3::MenuItem->new('Add h_idden object from string...');
$item_addHiddenString->signal_connect('activate' => sub {
$self->addHiddenObjCallback(TRUE);
});
$subMenu_addToModel->append($item_addHiddenString);
$subMenu_addToModel->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addSearchResult = Gtk3::MenuItem->new('Add _search result...');
$item_addSearchResult->signal_connect('activate' => sub {
$self->addSearchResultCallback();
});
$subMenu_addToModel->append($item_addSearchResult);
# (Also requires $self->mapObj->currentRoom that's the same as $self->selectedRoom)
if (! $self->mapObj->currentRoom || $self->mapObj->currentRoom ne $self->selectedRoom) {
$item_addSearchResult->set_sensitive(FALSE);
}
my $item_addToModel = Gtk3::MenuItem->new('Add to m_odel');
$item_addToModel->set_submenu($subMenu_addToModel);
$menu_rooms->append($item_addToModel);
$menu_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Add/set exits' submenu
my $subMenu_setExits = Gtk3::Menu->new();
my $item_addExit = Gtk3::MenuItem->new('Add _normal exit...');
$item_addExit->signal_connect('activate' => sub {
$self->addExitCallback(FALSE); # FALSE - not a hidden exit
});
$subMenu_setExits->append($item_addExit);
# (Also requires the selected room's ->wildMode to be 'normal' or 'border')
if ($self->selectedRoom->wildMode eq 'wild') {
$item_addExit->set_sensitive(FALSE);
}
my $item_addHiddenExit = Gtk3::MenuItem->new('Add _hidden exit...');
$item_addHiddenExit->signal_connect('activate' => sub {
$self->addExitCallback(TRUE); # TRUE - a hidden exit
});
$subMenu_setExits->append($item_addHiddenExit);
# (Also requires the selected room's ->wildMode to be 'normal' or 'border')
if ($self->selectedRoom->wildMode eq 'wild') {
$item_addHiddenExit->set_sensitive(FALSE);
}
$subMenu_setExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addMultiple = Gtk3::MenuItem->new('Add _multiple exits...');
$item_addMultiple->signal_connect('activate' => sub {
$self->addMultipleExitsCallback();
});
$subMenu_setExits->append($item_addMultiple);
$subMenu_setExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_removeChecked = Gtk3::MenuItem->new('Remove _checked direction...');
$item_removeChecked->signal_connect('activate' => sub {
$self->removeCheckedDirCallback(FALSE);
});
$subMenu_setExits->append($item_removeChecked);
# (Also requires the selected room's ->checkedDirHash to be non-empty)
if (! $self->selectedRoom->checkedDirHash) {
$item_removeChecked->set_sensitive(FALSE);
}
my $item_removeCheckedAll = Gtk3::MenuItem->new('Remove _all checked directions');
$item_removeCheckedAll->signal_connect('activate' => sub {
$self->removeCheckedDirCallback(TRUE);
});
$subMenu_setExits->append($item_removeCheckedAll);
# (Also requires the selected room's ->checkedDirHash to be non-empty)
if (! $self->selectedRoom->checkedDirHash) {
$item_removeCheckedAll->set_sensitive(FALSE);
}
$subMenu_setExits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_markNormal = Gtk3::MenuItem->new('Mark room as n_ormal');
$item_markNormal->signal_connect('activate' => sub {
$self->setWildCallback('normal');
});
$subMenu_setExits->append($item_markNormal);
my $item_markWild = Gtk3::MenuItem->new('Mark room as _wilderness');
$item_markWild->signal_connect('activate' => sub {
$self->setWildCallback('wild');
});
$subMenu_setExits->append($item_markWild);
# (Also requires $self->session->currentWorld->basicMappingFlag to be FALSE)
if ($self->session->currentWorld->basicMappingFlag) {
$item_markWild->set_sensitive(FALSE);
}
my $item_markBorder = Gtk3::MenuItem->new('Mark room as wilderness _border');
$item_markBorder->signal_connect('activate' => sub {
$self->setWildCallback('border');
});
$subMenu_setExits->append($item_markBorder);
# (Also requires $self->session->currentWorld->basicMappingFlag to be FALSE)
if ($self->session->currentWorld->basicMappingFlag) {
$item_markBorder->set_sensitive(FALSE);
}
my $item_setExits = Gtk3::ImageMenuItem->new('Add/set _exits');
my $img_setExits = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_setExits->set_image($img_setExits);
$item_setExits->set_submenu($subMenu_setExits);
$menu_rooms->append($item_setExits);
my $item_selectExit = Gtk3::MenuItem->new('Se_lect exit...');
$item_selectExit->signal_connect('activate' => sub {
$self->selectExitCallback();
});
$menu_rooms->append($item_selectExit);
$menu_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editRoom = Gtk3::ImageMenuItem->new('Ed_it room...');
my $img_editRoom = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editRoom->set_image($img_editRoom);
$item_editRoom->signal_connect('activate' => sub {
if ($self->selectedRoom) {
# Open the room's 'edit' window
$self->createFreeWin(
'Games::Axmud::EditWin::ModelObj::Room',
$self,
$self->session,
'Edit ' . $self->selectedRoom->category . ' model object',
$self->selectedRoom,
FALSE, # Not temporary
);
}
});
$menu_rooms->append($item_editRoom);
# 'Set room text' submenu
my $subMenu_setRoomText = Gtk3::Menu->new();
my $item_setRoomTag = Gtk3::MenuItem->new('Set room _tag...');
$item_setRoomTag->signal_connect('activate' => sub {
$self->setRoomTagCallback();
});
$subMenu_setRoomText->append($item_setRoomTag);
my $item_setGuild = Gtk3::MenuItem->new('Set room _guild...');
$item_setGuild->signal_connect('activate' => sub {
$self->setRoomGuildCallback();
});
$subMenu_setRoomText->append($item_setGuild);
$subMenu_setRoomText->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_resetPositions = Gtk3::MenuItem->new('_Reset text posit_ions');
$item_resetPositions->signal_connect('activate' => sub {
$self->resetRoomOffsetsCallback();
});
$subMenu_setRoomText->append($item_resetPositions);
my $item_setRoomText = Gtk3::MenuItem->new('Set _room text');
$item_setRoomText->set_submenu($subMenu_setRoomText);
$menu_rooms->append($item_setRoomText);
# 'Toggle room flag' submenu
my $subMenu_toggleRoomFlag = Gtk3::Menu->new();
if ($self->worldModelObj->roomFlagShowMode eq 'default') {
# Show all room flags, sorted by filter
foreach my $filter ($axmud::CLIENT->constRoomFilterList) {
# A sub-sub menu for $filter
my $subSubMenu_filter = Gtk3::Menu->new();
my @nameList = $self->worldModelObj->getRoomFlagsInFilter($filter);
foreach my $name (@nameList) {
my $obj = $self->worldModelObj->ivShow('roomFlagHash', $name);
if ($obj) {
my $menuItem = Gtk3::MenuItem->new($obj->descrip);
$menuItem->signal_connect('activate' => sub {
# Toggle the flags for all selected rooms, redraw them and (if the
# flag is one of the hazardous room flags) recalculate the
# regionmap's paths. The TRUE argument tells the world model to
# redraw the rooms
$self->worldModelObj->toggleRoomFlags(
$self->session,
TRUE,
$obj->name,
$self->compileSelectedRooms(),
);
});
$subSubMenu_filter->append($menuItem);
}
}
if (! @nameList) {
my $menuItem = Gtk3::MenuItem->new('(No flags in this filter)');
$menuItem->set_sensitive(FALSE);
$subSubMenu_filter->append($menuItem);
}
my $menuItem = Gtk3::MenuItem->new(ucfirst($filter));
$menuItem->set_submenu($subSubMenu_filter);
$subMenu_toggleRoomFlag->append($menuItem);
}
} else {
# Show selected room flags, sorted only by priority
my %showHash = $self->worldModelObj->getVisibleRoomFlags();
if (%showHash) {
foreach my $obj (sort {$a->priority <=> $b->priority} (values %showHash)) {
my $menuItem = Gtk3::MenuItem->new($obj->descrip);
$menuItem->signal_connect('activate' => sub {
# Toggle the flags for all selected rooms, redraw them and (if the
# flag is one of the hazardous room flags) recalculate the
# regionmap's paths. The TRUE argument tells the world model to
# redraw the rooms
$self->worldModelObj->toggleRoomFlags(
$self->session,
TRUE,
$obj->name,
$self->compileSelectedRooms(),
);
});
$subMenu_toggleRoomFlag->append($menuItem);
}
} else {
my $menuItem = Gtk3::MenuItem->new('(None are marked visible)');
$menuItem->set_sensitive(FALSE);
$subMenu_toggleRoomFlag->append($menuItem);
}
}
my $item_toggleRoomFlag = Gtk3::MenuItem->new('To_ggle room flags');
$item_toggleRoomFlag->set_submenu($subMenu_toggleRoomFlag);
$menu_rooms->append($item_toggleRoomFlag);
# 'Other room features' submenu
my $subMenu_roomFeatures = Gtk3::Menu->new();
# 'Update character visits' sub-submenu
my $subSubMenu_updateVisits = Gtk3::Menu->new();
my $item_increaseSetCurrent = Gtk3::MenuItem->new('Increase & set _current');
$item_increaseSetCurrent->signal_connect('activate' => sub {
$self->updateVisitsCallback('increase');
$self->mapObj->setCurrentRoom($self->selectedRoom);
});
$subSubMenu_updateVisits->append($item_increaseSetCurrent);
$subSubMenu_updateVisits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_increaseVisits = Gtk3::MenuItem->new('_Increase by one');
$item_increaseVisits->signal_connect('activate' => sub {
$self->updateVisitsCallback('increase');
});
$subSubMenu_updateVisits->append($item_increaseVisits);
my $item_decreaseVisits = Gtk3::MenuItem->new('_Decrease by one');
$item_decreaseVisits->signal_connect('activate' => sub {
$self->updateVisitsCallback('decrease');
});
$subSubMenu_updateVisits->append($item_decreaseVisits);
my $item_manualVisits = Gtk3::MenuItem->new('Set _manually');
$item_manualVisits->signal_connect('activate' => sub {
$self->updateVisitsCallback('manual');
});
$subSubMenu_updateVisits->append($item_manualVisits);
my $item_resetVisits = Gtk3::MenuItem->new('_Reset to zero');
$item_resetVisits->signal_connect('activate' => sub {
$self->updateVisitsCallback('reset');
});
$subSubMenu_updateVisits->append($item_resetVisits);
$subSubMenu_updateVisits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_toggleGraffiti = Gtk3::MenuItem->new('Toggle _graffiti');
$item_toggleGraffiti->signal_connect('activate' => sub {
$self->toggleGraffitiCallback();
});
$subSubMenu_updateVisits->append($item_toggleGraffiti);
# (Also requires $self->graffitiModeFlag)
if (! $self->graffitiModeFlag) {
$item_toggleGraffiti->set_sensitive(FALSE);
}
my $item_updateVisits = Gtk3::MenuItem->new('Update character _visits');
$item_updateVisits->set_submenu($subSubMenu_updateVisits);
$subMenu_roomFeatures->append($item_updateVisits);
# 'Room exclusivity' submenu
my $subMenu_exclusivity = Gtk3::Menu->new();
my $item_toggleExclusivity = Gtk3::MenuItem->new('_Toggle exclusivity');
$item_toggleExclusivity->signal_connect('activate' => sub {
$self->toggleExclusiveProfileCallback();
});
$subMenu_exclusivity->append($item_toggleExclusivity);
my $item_addExclusiveProf = Gtk3::MenuItem->new('_Add exclusive profile...');
$item_addExclusiveProf->signal_connect('activate' => sub {
$self->addExclusiveProfileCallback();
});
$subMenu_exclusivity->append($item_addExclusiveProf);
my $item_clearExclusiveProf = Gtk3::MenuItem->new('_Clear exclusive profiles');
$item_clearExclusiveProf->signal_connect('activate' => sub {
$self->resetExclusiveProfileCallback();
});
$subMenu_exclusivity->append($item_clearExclusiveProf);
my $item_exclusivity = Gtk3::MenuItem->new('Room _exclusivity');
$item_exclusivity->set_submenu($subMenu_exclusivity);
$subMenu_roomFeatures->append($item_exclusivity);
# 'Source code' sub-submenu
my $subSubMenu_sourceCode = Gtk3::Menu->new();
my $item_setFilePath = Gtk3::MenuItem->new('_Set file path...');
$item_setFilePath->signal_connect('activate' => sub {
$self->setFilePathCallback();
});
$subSubMenu_sourceCode->append($item_setFilePath);
my $item_setVirtualArea = Gtk3::MenuItem->new('Set virtual _area...');
$item_setVirtualArea->signal_connect('activate' => sub {
$self->setVirtualAreaCallback(TRUE);
});
$subSubMenu_sourceCode->append($item_setVirtualArea);
my $item_resetVirtualArea = Gtk3::MenuItem->new('_Reset virtual area...');
$item_resetVirtualArea->signal_connect('activate' => sub {
$self->setVirtualAreaCallback(FALSE);
});
$subSubMenu_sourceCode->append($item_resetVirtualArea);
$subSubMenu_sourceCode->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_viewSource = Gtk3::MenuItem->new('_View source file...');
$item_viewSource->signal_connect('activate' => sub {
my $flag;
if ($self->selectedRoom) {
if (! $self->selectedRoom->virtualAreaPath) {
$flag = FALSE;
} else {
$flag = TRUE;
}
# Show source code file
$self->quickFreeWin(
'Games::Axmud::OtherWin::SourceCode',
$self->session,
# Config
'model_obj' => $self->selectedRoom,
'virtual_flag' => $flag,
);
}
});
$subSubMenu_sourceCode->append($item_viewSource);
# (Also requires either $self->selectedRoom->sourceCodePath or
# $self->selectedRoom->virtualAreaPath)
if (
! $self->selectedRoom->sourceCodePath
&& ! $self->selectedRoom->virtualAreaPath
) {
$item_viewSource->set_sensitive(FALSE);
}
my $item_editSource = Gtk3::MenuItem->new('Edit so_urce file...');
$item_editSource->signal_connect('activate' => sub {
if ($self->selectedRoom) {
if (! $self->selectedRoom->virtualAreaPath) {
# Edit source code file
$self->editFileCallback();
} else {
# Edit virtual area file
$self->editFileCallback(TRUE);
}
}
});
$subSubMenu_sourceCode->append($item_editSource);
# (Also requires either $self->selectedRoom->sourceCodePath or
# $self->selectedRoom->virtualAreaPath)
if (
! $self->selectedRoom->sourceCodePath
&& ! $self->selectedRoom->virtualAreaPath
) {
$item_editSource->set_sensitive(FALSE);
}
my $item_sourceCode = Gtk3::MenuItem->new('Source _code');
$item_sourceCode->set_submenu($subSubMenu_sourceCode);
$subMenu_roomFeatures->append($item_sourceCode);
$subMenu_roomFeatures->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setInteriorOffsets = Gtk3::MenuItem->new('_Synchronise grid coordinates...');
$item_setInteriorOffsets->signal_connect('activate' => sub {
$self->setInteriorOffsetsCallback();
});
$subMenu_roomFeatures->append($item_setInteriorOffsets);
my $item_resetInteriorOffsets = Gtk3::MenuItem->new('_Reset grid coordinates');
$item_resetInteriorOffsets->signal_connect('activate' => sub {
$self->resetInteriorOffsetsCallback();
});
$subMenu_roomFeatures->append($item_resetInteriorOffsets);
my $item_roomFeatures = Gtk3::MenuItem->new('Ot_her room features');
$item_roomFeatures->set_submenu($subMenu_roomFeatures);
$menu_rooms->append($item_roomFeatures);
$menu_rooms->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_deleteRoom = Gtk3::ImageMenuItem->new('_Delete room');
my $img_deleteRoom = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_deleteRoom->set_image($img_deleteRoom);
$item_deleteRoom->signal_connect('activate' => sub {
$self->deleteRoomsCallback();
});
$menu_rooms->append($item_deleteRoom);
# Setup complete
$menu_rooms->show_all();
return $menu_rooms;
}
sub enableRoomTagsPopupMenu {
# Called by $self->canvasObjEventHandler
# Creates a popup-menu for the selected room tag
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->enableRoomTagsPopupMenu',
@_,
);
}
# Set up the popup menu
my $menu_tags = Gtk3::Menu->new();
if (! $menu_tags) {
return undef;
}
# (Everything here assumes $self->currentRegionmap and $self->selectedRoomTag)
my $item_editTag = Gtk3::MenuItem->new('_Set room tag...');
$item_editTag->signal_connect('activate' => sub {
$self->setRoomTagCallback();
});
$menu_tags->append($item_editTag);
my $item_resetPosition = Gtk3::MenuItem->new('_Reset position');
$item_resetPosition->signal_connect('activate' => sub {
if ($self->selectedRoomTag) {
$self->worldModelObj->resetRoomOffsets(
TRUE, # Update Automapper windows now
1, # Mode 1 - reset room tag only
$self->selectedRoomTag, # Set to the parent room's blessed reference
);
}
});
$menu_tags->append($item_resetPosition);
# Setup complete
$menu_tags->show_all();
return $menu_tags;
}
sub enableRoomGuildsPopupMenu {
# Called by $self->canvasObjEventHandler
# Creates a popup-menu for the selected room guild
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->enableRoomGuildsPopupMenu',
@_,
);
}
# Set up the popup menu
my $menu_guilds = Gtk3::Menu->new();
if (! $menu_guilds) {
return undef;
}
# (Everything here assumes $self->currentRegionmap and $self->selectedRoomGuild)
my $item_editGuild = Gtk3::MenuItem->new('_Set room guild...');
$item_editGuild->signal_connect('activate' => sub {
$self->setRoomGuildCallback();
});
$menu_guilds->append($item_editGuild);
my $item_resetPosition = Gtk3::MenuItem->new('_Reset position');
$item_resetPosition->signal_connect('activate' => sub {
if ($self->selectedRoomGuild) {
$self->worldModelObj->resetRoomOffsets(
TRUE, # Update Automapper windows now
2, # Mode 2 - reset room guild only
$self->selectedRoomGuild, # Set to the parent room's blessed reference
);
}
});
$menu_guilds->append($item_resetPosition);
# Setup complete
$menu_guilds->show_all();
return $menu_guilds;
}
sub enableExitsPopupMenu {
# Called by $self->canvasObjEventHandler
# Creates a popup-menu for the selected exit
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Local variables
my @titleList;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableExitsPopupMenu', @_);
}
# Set up the popup menu
my $menu_exits = Gtk3::Menu->new();
if (! $menu_exits) {
return undef;
}
# (Everything here assumes $self->currentRegionmap and $self->selectedExit)
# 'Allocate map direction' submenu
my $subMenu_setDir = Gtk3::Menu->new();
my $item_changeDir = Gtk3::MenuItem->new('_Change direction...');
$item_changeDir->signal_connect('activate' => sub {
$self->changeDirCallback();
});
$subMenu_setDir->append($item_changeDir);
# (Also requires $self->selectedExit->drawMode is 'primary' or 'perm_alloc'
if (
$self->selectedExit->drawMode ne 'primary'
&& $self->selectedExit->drawMode ne 'perm_alloc'
) {
$item_changeDir->set_sensitive(FALSE);
}
my $item_altDir = Gtk3::MenuItem->new('Set _alternative direction(s)...');
$item_altDir->signal_connect('activate' => sub {
$self->setAltDirCallback();
});
$subMenu_setDir->append($item_altDir);
my $item_setDir = Gtk3::MenuItem->new('Set di_rection');
$item_setDir->set_submenu($subMenu_setDir);
$menu_exits->append($item_setDir);
my $item_setAssisted = Gtk3::MenuItem->new('Set assisted _move...');
$item_setAssisted->signal_connect('activate' => sub {
$self->setAssistedMoveCallback();
});
$menu_exits->append($item_setAssisted);
# (Also requires $self->selectedExit->drawMode 'primary', 'temp_unalloc' or 'perm_unalloc')
if ($self->selectedExit->drawMode eq 'temp_alloc') {
$item_setAssisted->set_sensitive(FALSE);
}
# 'Allocate map direction' submenu
my $subMenu_allocateMapDir = Gtk3::Menu->new();
my $item_allocatePrimary = Gtk3::MenuItem->new('Choose _direction...');
$item_allocatePrimary->signal_connect('activate' => sub {
$self->allocateMapDirCallback();
});
$subMenu_allocateMapDir->append($item_allocatePrimary);
my $item_confirmTwoWay = Gtk3::MenuItem->new('Confirm _two-way exit...');
$item_confirmTwoWay->signal_connect('activate' => sub {
$self->confirmTwoWayCallback();
});
$subMenu_allocateMapDir->append($item_confirmTwoWay);
my $item_allocateMapDir = Gtk3::MenuItem->new('_Allocate map direction...');
$item_allocateMapDir->set_submenu($subMenu_allocateMapDir);
$menu_exits->append($item_allocateMapDir);
# (Also requires $self->selectedExit->drawMode is 'temp_alloc' or 'temp_unalloc')
if (
$self->selectedExit->drawMode ne 'temp_alloc'
&& $self->selectedExit->drawMode ne 'temp_unalloc'
) {
$item_allocateMapDir->set_sensitive(FALSE);
}
my $item_allocateShadow = Gtk3::MenuItem->new('Allocate _shadow...');
$item_allocateShadow->signal_connect('activate' => sub {
$self->allocateShadowCallback();
});
$menu_exits->append($item_allocateShadow);
# (Also requires $self->selectedExit->drawMode is 'temp_alloc' or 'temp_unalloc')
if (
$self->selectedExit->drawMode ne 'temp_alloc'
&& $self->selectedExit->drawMode ne 'temp_unalloc'
) {
$item_allocateShadow->set_sensitive(FALSE);
}
$menu_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_connectExitToClick = Gtk3::MenuItem->new('_Connect to click');
$item_connectExitToClick->signal_connect('activate' => sub {
$self->connectToClickCallback();
});
$menu_exits->append($item_connectExitToClick);
# (Also requires $self->selectedExit->drawMode 'primary', 'temp_unalloc' or 'perm_unalloc')
if ($self->selectedExit->drawMode eq 'temp_alloc') {
$item_connectExitToClick->set_sensitive(FALSE);
}
my $item_disconnectExit = Gtk3::MenuItem->new('D_isconnect exit');
$item_disconnectExit->signal_connect('activate' => sub {
$self->disconnectExitCallback();
});
$menu_exits->append($item_disconnectExit);
$menu_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_addExitBend = Gtk3::MenuItem->new('Add _bend');
$item_addExitBend->signal_connect('activate' => sub {
$self->addBendCallback();
});
$menu_exits->append($item_addExitBend);
# (Also requires a $self->selectedExit that's a one-way or two-way broken exit, not a region
# exit, and also defined values for $self->exitClickXPosn and $self->exitClickYPosn)
if (
(! $self->selectedExit->oneWayFlag && ! $self->selectedExit->twinExit)
|| $self->selectedExit->regionFlag
|| ! defined $self->exitClickXPosn
|| ! defined $self->exitClickYPosn
) {
$item_addExitBend->set_sensitive(FALSE);
}
my $item_removeExitBend = Gtk3::MenuItem->new('Remo_ve bend');
$item_removeExitBend->signal_connect('activate' => sub {
$self->removeBendCallback();
});
$menu_exits->append($item_removeExitBend);
# (Also requires a $self->selectedExit that's a one-way or two-way exit with a bend, and
# also defined values for $self->exitClickXPosn and $self->exitClickYPosn)
if (
(! $self->selectedExit->oneWayFlag && ! $self->selectedExit->twinExit)
|| ! $self->selectedExit->bendOffsetList
|| ! defined $self->exitClickXPosn
|| ! defined $self->exitClickYPosn
) {
$item_removeExitBend->set_sensitive(FALSE);
}
$menu_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Set ornaments' submenu
my $subMenu_setOrnament = Gtk3::Menu->new();
# Create a list of exit ornament types, in groups of two, in the form
# (menu_item_title, exit_ornament_type)
@titleList = (
'_No ornament', 'none',
'_Openable exit', 'open',
'_Lockable exit', 'lock',
'_Pickable exit', 'pick',
'_Breakable exit', 'break',
'_Impassable exit', 'impass',
'_Mystery exit', 'mystery',
);
do {
my ($title, $type);
$title = shift @titleList;
$type = shift @titleList;
my $menuItem = Gtk3::MenuItem->new($title);
$menuItem->signal_connect('activate' => sub {
$self->exitOrnamentCallback($type);
});
$subMenu_setOrnament->append($menuItem);
} until (! @titleList);
$subMenu_setOrnament->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setTwinOrnament = Gtk3::CheckMenuItem->new('Also set _twin exits');
$item_setTwinOrnament->set_active($self->worldModelObj->setTwinOrnamentFlag);
$item_setTwinOrnament->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'setTwinOrnamentFlag',
$item_setTwinOrnament->get_active(),
FALSE, # Don't call $self->redrawRegions
'also_set_twin_exits',
);
}
});
$subMenu_setOrnament->append($item_setTwinOrnament);
my $item_setOrnament = Gtk3::MenuItem->new('Set _ornaments');
$item_setOrnament->set_submenu($subMenu_setOrnament);
$menu_exits->append($item_setOrnament);
# 'Set exit type' submenu
my $subMenu_setExitType = Gtk3::Menu->new();
# 'Set hidden' sub-submenu
my $subSubMenu_setHidden = Gtk3::Menu->new();
my $item_setHiddenExit = Gtk3::MenuItem->new('Mark exit _hidden');
$item_setHiddenExit->signal_connect('activate' => sub {
$self->hiddenExitCallback(TRUE);
});
$subSubMenu_setHidden->append($item_setHiddenExit);
my $item_setNotHiddenExit = Gtk3::MenuItem->new('Mark exit _not hidden');
$item_setNotHiddenExit->signal_connect('activate' => sub {
$self->hiddenExitCallback(FALSE);
});
$subSubMenu_setHidden->append($item_setNotHiddenExit);
my $item_setHidden = Gtk3::MenuItem->new('Set _hidden');
$item_setHidden->set_submenu($subSubMenu_setHidden);
$subMenu_setExitType->append($item_setHidden);
# 'Set broken' sub-submenu
my $subSubMenu_setBroken = Gtk3::Menu->new();
my $item_markBrokenExit = Gtk3::MenuItem->new('_Mark exit as broken');
$item_markBrokenExit->signal_connect('activate' => sub {
$self->markBrokenExitCallback();
});
$subSubMenu_setBroken->append($item_markBrokenExit);
my $item_toggleBrokenExit = Gtk3::MenuItem->new('_Toggle bent broken exit');
$item_toggleBrokenExit->signal_connect('activate' => sub {
$self->worldModelObj->toggleBentExit(
TRUE, # Update Automapper windows now
$self->selectedExit,
);
});
$subSubMenu_setBroken->append($item_toggleBrokenExit);
# (Also requires $self->selectedExit->brokenFlag)
if (! $self->selectedExit->brokenFlag) {
$item_toggleBrokenExit->set_sensitive(FALSE);
}
$subSubMenu_setBroken->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_restoreBrokenExit = Gtk3::MenuItem->new('_Restore unbroken exit');
$item_restoreBrokenExit->signal_connect('activate' => sub {
$self->restoreBrokenExitCallback();
});
$subSubMenu_setBroken->append($item_restoreBrokenExit);
my $item_setBroken = Gtk3::MenuItem->new('Set _broken');
$item_setBroken->set_submenu($subSubMenu_setBroken);
$subMenu_setExitType->append($item_setBroken);
# 'Set one-way' sub-submenu
my $subSubMenu_setOneWay = Gtk3::Menu->new();
my $item_markOneWayExit = Gtk3::MenuItem->new('_Mark exit as one-way');
$item_markOneWayExit->signal_connect('activate' => sub {
$self->markOneWayExitCallback();
});
$subSubMenu_setOneWay->append($item_markOneWayExit);
$subSubMenu_setOneWay->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_restoreUncertainExit = Gtk3::MenuItem->new('Restore _uncertain exit');
$item_restoreUncertainExit->signal_connect('activate' => sub {
$self->restoreOneWayExitCallback(FALSE);
});
$subSubMenu_setOneWay->append($item_restoreUncertainExit);
my $item_restoreTwoWayExit = Gtk3::MenuItem->new('Restore _two-way exit');
$item_restoreTwoWayExit->signal_connect('activate' => sub {
$self->restoreOneWayExitCallback(TRUE);
});
$subSubMenu_setOneWay->append($item_restoreTwoWayExit);
$subSubMenu_setOneWay->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setIncomingDir = Gtk3::MenuItem->new('Set incoming _direction...');
$item_setIncomingDir->signal_connect('activate' => sub {
$self->setIncomingDirCallback();
});
$subSubMenu_setOneWay->append($item_setIncomingDir);
# (Also requires either a $self->selectedExit which is a one-way exit)
if (! $self->selectedExit->oneWayFlag) {
$item_setIncomingDir->set_sensitive(FALSE);
}
my $item_setOneWay = Gtk3::MenuItem->new('Set _one-way');
$item_setOneWay->set_submenu($subSubMenu_setOneWay);
$subMenu_setExitType->append($item_setOneWay);
# 'Set retracing' sub-submenu
my $subSubMenu_setRetracing = Gtk3::Menu->new();
my $item_markRetracingExit = Gtk3::MenuItem->new('_Mark exit as retracing');
$item_markRetracingExit->signal_connect('activate' => sub {
$self->markRetracingExitCallback();
});
$subSubMenu_setRetracing->append($item_markRetracingExit);
$subSubMenu_setRetracing->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_restoreRetracingExit = Gtk3::MenuItem->new('_Restore incomplete exit');
$item_restoreRetracingExit->signal_connect('activate' => sub {
$self->restoreRetracingExitCallback();
});
$subSubMenu_setRetracing->append($item_restoreRetracingExit);
my $item_setRetracing = Gtk3::MenuItem->new('Set _retracing');
$item_setRetracing->set_submenu($subSubMenu_setRetracing);
$subMenu_setExitType->append($item_setRetracing);
# 'Set random' sub-submenu
my $subSubMenu_setRandomExit = Gtk3::Menu->new();
my $item_markRandomRegion = Gtk3::MenuItem->new(
'Set random destination in same _region',
);
$item_markRandomRegion->signal_connect('activate' => sub {
$self->markRandomExitCallback('same_region');
});
$subSubMenu_setRandomExit->append($item_markRandomRegion);
my $item_markRandomAnywhere = Gtk3::MenuItem->new(
'Set random destination _anywhere',
);
$item_markRandomAnywhere->signal_connect('activate' => sub {
$self->markRandomExitCallback('any_region');
});
$subSubMenu_setRandomExit->append($item_markRandomAnywhere);
my $item_randomTempRegion = Gtk3::MenuItem->new(
'_Create destination in temporary region',
);
$item_randomTempRegion->signal_connect('activate' => sub {
$self->markRandomExitCallback('temp_region');
});
$subSubMenu_setRandomExit->append($item_randomTempRegion);
my $item_markRandomList = Gtk3::MenuItem->new('_Use list of random destinations');
$item_markRandomList->signal_connect('activate' => sub {
$self->markRandomExitCallback('room_list');
});
$subSubMenu_setRandomExit->append($item_markRandomList);
$subSubMenu_setRandomExit->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_restoreRandomExit = Gtk3::MenuItem->new('Restore _incomplete exit');
$item_restoreRandomExit->signal_connect('activate' => sub {
$self->restoreRandomExitCallback();
});
$subSubMenu_setRandomExit->append($item_restoreRandomExit);
my $item_setRandomExit = Gtk3::MenuItem->new('Set r_andom');
$item_setRandomExit->set_submenu($subSubMenu_setRandomExit);
$subMenu_setExitType->append($item_setRandomExit);
# 'Set super' sub-submenu
my $subSubMenu_setSuperExit = Gtk3::Menu->new();
my $item_markSuper = Gtk3::MenuItem->new('Mark exit as _super-region exit');
$item_markSuper->signal_connect('activate' => sub {
$self->markSuperExitCallback(FALSE);
});
$subSubMenu_setSuperExit->append($item_markSuper);
my $item_markSuperExcl = Gtk3::MenuItem->new(
'Mark exit as _exclusive super-region exit',
);
$item_markSuperExcl->signal_connect('activate' => sub {
$self->markSuperExitCallback(TRUE);
});
$subSubMenu_setSuperExit->append($item_markSuperExcl);
$subSubMenu_setSuperExit->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_markNotSuper = Gtk3::MenuItem->new('Mark exit as _normal region exit');
$item_markNotSuper->signal_connect('activate' => sub {
$self->restoreSuperExitCallback();
});
$subSubMenu_setSuperExit->append($item_markNotSuper);
my $item_setSuperExit = Gtk3::MenuItem->new('Set _super');
$item_setSuperExit->set_submenu($subSubMenu_setSuperExit);
$subMenu_setExitType->append($item_setSuperExit);
# (Also requires $self->selectedExit->regionFlag)
if (! $self->selectedExit->regionFlag) {
$item_setSuperExit->set_sensitive(FALSE);
}
$subMenu_setExitType->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_setExitTwin = Gtk3::MenuItem->new('Set exit _twin...');
$item_setExitTwin->signal_connect('activate' => sub {
$self->setExitTwinCallback();
});
$subMenu_setExitType->append($item_setExitTwin);
# (Also requires either a $self->selectedExit which is either a one-way exit or an
# uncertain exit)
if (
! $self->selectedExit->oneWayFlag
|| ! (
$self->selectedExit->destRoom
&& ! $self->selectedExit->twinExit
&& ! $self->selectedExit->retraceFlag
&& $self->selectedExit->randomType eq 'none'
)
) {
$item_setExitTwin->set_sensitive(FALSE);
}
my $item_setExitType = Gtk3::MenuItem->new('Set _exit type');
$item_setExitType->set_submenu($subMenu_setExitType);
$menu_exits->append($item_setExitType);
# 'Exit tags' submenu
my $subMenu_exitTags = Gtk3::Menu->new();
my $item_editTag = Gtk3::MenuItem->new('_Edit exit tag');
$item_editTag->signal_connect('activate' => sub {
$self->editExitTagCallback();
});
$subMenu_exitTags->append($item_editTag);
my $item_toggleExitTag = Gtk3::MenuItem->new('_Toggle exit tag');
$item_toggleExitTag->signal_connect('activate' => sub {
$self->toggleExitTagCallback();
});
$subMenu_exitTags->append($item_toggleExitTag);
$subMenu_exitTags->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_resetPosition = Gtk3::MenuItem->new('_Reset text position');
$item_resetPosition->signal_connect('activate' => sub {
$self->resetExitOffsetsCallback();
});
$subMenu_exitTags->append($item_resetPosition);
my $item_exitTags = Gtk3::MenuItem->new('Exit _tags');
$item_exitTags->set_submenu($subMenu_exitTags);
$menu_exits->append($item_exitTags);
# (Also requires either a $self->selectedExit which is a region exit)
if (! $self->selectedExit->regionFlag) {
$item_exitTags->set_sensitive(FALSE);
}
$menu_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_editExit = Gtk3::ImageMenuItem->new('Edit e_xit...');
my $img_editExit = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_editExit->set_image($img_editExit);
$item_editExit->signal_connect('activate' => sub {
$self->editExitCallback();
});
$menu_exits->append($item_editExit);
$menu_exits->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_deleteExit = Gtk3::ImageMenuItem->new('_Delete exit');
my $img_deleteExit = Gtk3::Image->new_from_stock('gtk-add', 'menu');
$item_deleteExit->set_image($img_deleteExit);
$item_deleteExit->signal_connect('activate' => sub {
$self->deleteExitCallback();
});
$menu_exits->append($item_deleteExit);
# Setup complete
$menu_exits->show_all();
return $menu_exits;
}
sub enableExitTagsPopupMenu {
# Called by $self->canvasObjEventHandler
# Creates a popup-menu for the selected exit tag
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->enableExitTagsPopupMenu',
@_,
);
}
# Set up the popup menu
my $menu_tags = Gtk3::Menu->new();
if (! $menu_tags) {
return undef;
}
# (Everything here assumes $self->currentRegionmap and $self->selectedExitTag)
my $item_editTag = Gtk3::MenuItem->new('_Edit exit tag');
$item_editTag->signal_connect('activate' => sub {
$self->editExitTagCallback();
});
$menu_tags->append($item_editTag);
my $item_cancelTag = Gtk3::MenuItem->new('_Cancel exit tag');
$item_cancelTag->signal_connect('activate' => sub {
$self->toggleExitTagCallback();
});
$menu_tags->append($item_cancelTag);
$menu_tags->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_viewDestination = Gtk3::MenuItem->new('_View destination');
$item_viewDestination->signal_connect('activate' => sub {
$self->viewExitDestination();
});
$menu_tags->append($item_viewDestination);
$menu_tags->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_resetPosition = Gtk3::MenuItem->new('_Reset position');
$item_resetPosition->signal_connect('activate' => sub {
$self->resetExitOffsetsCallback();
});
$menu_tags->append($item_resetPosition);
# Setup complete
$menu_tags->show_all();
return $menu_tags;
}
sub enableLabelsPopupMenu {
# Called by $self->canvasObjEventHandler
# Creates a popup-menu for the selected label
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Menu created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableLabelsPopupMenu', @_);
}
# Set up the popup menu
my $menu_labels = Gtk3::Menu->new();
if (! $menu_labels) {
return undef;
}
# (Everything here assumes $self->currentRegionmap and $self->selectedLabel)
my $item_setLabel = Gtk3::ImageMenuItem->new('_Set label...');
my $img_setLabel = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_setLabel->set_image($img_setLabel);
$item_setLabel->signal_connect('activate' => sub {
$self->setLabelCallback(FALSE)
});
$menu_labels->append($item_setLabel);
my $item_customiseLabel = Gtk3::ImageMenuItem->new('_Customise label...');
my $img_customiseLabel = Gtk3::Image->new_from_stock('gtk-edit', 'menu');
$item_customiseLabel->set_image($img_customiseLabel);
$item_customiseLabel->signal_connect('activate' => sub {
$self->setLabelCallback(TRUE);
});
$menu_labels->append($item_customiseLabel);
$menu_labels->append(Gtk3::SeparatorMenuItem->new()); # Separator
# 'Set label style' submenu
my $subMenu_setStyle = Gtk3::Menu->new();
foreach my $style (
sort {lc($a) cmp lc($b)} ($self->worldModelObj->ivKeys('mapLabelStyleHash'))
) {
my $item_thisStyle = Gtk3::MenuItem->new($style);
$item_thisStyle->signal_connect('activate' => sub {
$self->setLabelDirectCallback($style);
});
$subMenu_setStyle->append($item_thisStyle);
}
my $item_setStyle = Gtk3::MenuItem->new('S_et label style');
$item_setStyle->set_submenu($subMenu_setStyle);
$menu_labels->append($item_setStyle);
# (Also requires at least one label style)
if (! $self->worldModelObj->mapLabelStyleHash) {
$item_setStyle->set_sensitive(FALSE);
}
$menu_labels->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $item_deleteLabel = Gtk3::ImageMenuItem->new('_Delete label');
my $img_deleteLabel = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_deleteLabel->set_image($img_deleteLabel);
$item_deleteLabel->signal_connect('activate' => sub {
if ($self->selectedLabel) {
$self->worldModelObj->deleteLabels(
TRUE, # Update Automapper windows now
$self->selectedLabel,
);
}
});
$menu_labels->append($item_deleteLabel);
my $item_quickDelete = Gtk3::ImageMenuItem->new('_Quick label deletion...');
my $img_quickDelete = Gtk3::Image->new_from_stock('gtk-delete', 'menu');
$item_quickDelete->set_image($img_quickDelete);
$item_quickDelete->signal_connect('activate' => sub {
$self->session->pseudoCmd('quicklabeldelete', $self->pseudoCmdMode);
});
$menu_labels->append($item_quickDelete);
# Setup complete
$menu_labels->show_all();
return $menu_labels;
}
# Toolbar widget methods
sub enableToolbar {
# Called by $self->drawWidgets
# Sets up the Automapper window's Gtk3::Toolbar widget(s)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if one of the widgets can't be created
# Otherwise returns a list of Gtk3::Toolbar widgets created
my ($self, $check) = @_;
# Local variables
my (
$flag,
@emptyList, @setList, @widgetList,
%checkHash,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->enableToolbar', @_);
return @emptyList;
}
# Import the list of button sets from the world model
# Remove 'default' (which shouldn't be there) and also remove any duplicates or unrecognised
# sets
foreach my $set ($self->worldModelObj->buttonSetList) {
if (
$set ne $self->constToolbarDefaultSet
&& ! exists $checkHash{$set}
&& $self->ivExists('buttonSetHash', $set)
) {
push (@setList, $set);
# Watch out for duplicates
$checkHash{$set} = undef;
}
}
# Draw the original (first) toolbar. The TRUE argument means that the add/switcher buttons
# should be drawn
my $origToolbar = $self->drawToolbar($self->toolbarOriginalSet, TRUE);
if (! $origToolbar) {
# Give up on the first error
return @emptyList;
} else {
push (@widgetList, $origToolbar);
}
# Draw a toolbar for each button set in turn, updating IVs as we go
foreach my $set (@setList) {
my $otherToolbar = $self->drawToolbar($set);
if (! $otherToolbar) {
# Give up on the first error (@widgetList might be an empty list)
return @widgetList;
} else {
push (@widgetList, $otherToolbar);
}
}
# On success, update the world model's list of button sets (having removed anything that
# shouldn't be there
$self->worldModelObj->set_buttonSetList(@setList);
# If all button sets are visible, the 'add'/'switch' buttons in the default set are
# desensitised
OUTER: foreach my $key ($self->ivKeys('buttonSetHash')) {
if (! $self->ivShow('buttonSetHash', $key)) {
$flag = TRUE;
last OUTER;
}
}
if (! $flag) {
$self->toolbarAddButton->set_sensitive(FALSE);
$self->toolbarSwitchButton->set_sensitive(FALSE);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return @widgetList;
}
sub drawToolbar {
# Called by $self->enableToolbar
# Creates a new toolbar using the button set specified by the calling function, and updates
# IVs accordingly
#
# Expected arguments
# $set - The button set to use (one of the items in $self->constButtonSetList)
#
# Optional arguments
# $origFlag - If TRUE, this is the original (first) toolbar; FALSE (or 'undef') for any
# subsequent toolbar
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Toolbar created
my ($self, $set, $origFlag, $check) = @_;
# Local variables
my (
$text, $text2, $text3,
@buttonList,
);
# Check for improper arguments
if (! defined $set || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawToolbar', @_);
}
# Check the button set actually exists
if (! $self->ivExists('buttonSetHash', $set)) {
return undef;
}
# Create the toolbar widget
my $toolbar = Gtk3::Toolbar->new();
if (! $toolbar) {
return undef;
}
# Store the widget and update associated IVs
$self->ivAdd('buttonSetHash', $set, TRUE);
$self->ivPush('toolbarList', $toolbar);
$self->ivAdd('toolbarHash', $toolbar, $set);
# Use large icons, and allow the menu to shrink when there's not enough space for it
$toolbar->set_icon_size('large-toolbar');
$toolbar->set_show_arrow(TRUE);
if ($axmud::CLIENT->toolbarLabelFlag) {
# Otherwise, these values continue to be 'undef', which is what Gtk3::ToolButton is
# expecting
$text = 'Switch button sets';
$text2 = 'Add button set';
$text3 = 'Remove button set';
}
# Add buttons that are displayed, regardless of which button set is visible
if ($origFlag) {
# Draw an add button, which adds new toolbars (unless all button sets are visible)
my $toolButton = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_add.png'),
$text2,
);
$toolButton->signal_connect('clicked' => sub {
# Switch to the next set of toolbar buttons
$self->addToolbar();
});
$toolButton->set_tooltip_text('Add button set');
$toolbar->insert($toolButton, -1);
# Draw a switcher button, which cycles through button sets that aren't visible in other
# toolbars
my $toolButton2 = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_switch.png'),
$text,
);
$toolButton2->signal_connect('clicked' => sub {
# Switch to the next set of toolbar buttons
$self->switchToolbarButtons();
});
$toolButton2->set_tooltip_text('Switch button sets');
$toolbar->insert($toolButton2, -1);
# Update IVs
$self->ivPoke('toolbarOriginalSet', $set);
$self->ivPoke('toolbarAddButton', $toolButton);
$self->ivPoke('toolbarSwitchButton', $toolButton2);
} else {
# Draw a remove button, which adds new toolbars (unless all button sets are visible)
my $toolButton = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_remove.png'),
$text3,
);
$toolButton->signal_connect('clicked' => sub {
# Switch to the next set of toolbar buttons
$self->removeToolbar($toolbar);
});
$toolButton->set_tooltip_text('Remove button set');
$toolbar->insert($toolButton, -1);
}
# Immediately to the right of those buttons is a separator
my $separator2 = Gtk3::SeparatorToolItem->new();
$toolbar->insert($separator2, -1);
# After the separator, we draw the specified button set. This function decides which
# specific function to call, and returns the result
@buttonList = $self->chooseButtonSet($toolbar, $set);
# Add the buttons/separators to the toolbar
foreach my $button (@buttonList) {
my $label;
# (Separators don't have labels, so we need to check for that)
if (! $axmud::CLIENT->toolbarLabelFlag && $button->isa('Gtk3::ToolButton')) {
$button->set_label(undef);
}
$toolbar->insert($button, -1);
}
# Update IVs
if ($origFlag) {
$self->ivPoke('toolbarButtonList', @buttonList);
}
# Setup complete
return $toolbar;
}
sub switchToolbarButtons {
# Called by a ->signal_connect in $self->addToolbar whenever the user clicks the original
# toolbar's switcher button
# Removes the existing button set (preserving the switcher and add buttons, and the
# separator that follows them), and then draws a new button set
# NB This function is only called for the original (first) toolbar, not for any additional
# toolbars
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$toolbar, $currentSet, $foundFlag, $nextSet,
@setList, @beforeList, @afterList, @buttonList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->switchToolbarButtons', @_);
}
# Get the original toolbar (always the first one in this list)
$toolbar = $self->ivFirst('toolbarList');
if (! $toolbar) {
return undef;
}
# Decide which button set to show next
$currentSet = $self->ivShow('toolbarHash', $toolbar);
if (! $currentSet) {
return undef;
}
# Compile a list of all button sets but the current one, starting with those which appear
# after the current one, then those that appear before it
# e.g. (A B current D E F) > (D E F A B)
@setList = $self->constButtonSetList;
for (my $count = 0; $count < scalar @setList; $count++) {
if ($setList[$count] eq $currentSet) {
$foundFlag = TRUE;
} elsif ($foundFlag) {
push (@afterList, $setList[$count]);
} else {
push (@beforeList, $setList[$count]);
}
}
# Go through that list, from the beginning, and use the first button set that's not already
# visible
OUTER: foreach my $set (@afterList, @beforeList) {
if (! $self->ivShow('buttonSetHash', $set)) {
$nextSet = $set;
last OUTER;
}
}
if (! $nextSet) {
# All button sets are visible; cannot switch set
return undef;
}
# Remove the existing button set (preserving the switcher and add buttons, and the separator
# that follows them)
foreach my $widget ($self->toolbarButtonList) {
$axmud::CLIENT->desktopObj->removeWidget($toolbar, $widget);
}
# After the separator, we draw the specified button set. This function decides which
# specific function to call, and returns the result
@buttonList = $self->chooseButtonSet($toolbar, $nextSet);
# Add the buttons/separators to the toolbar
foreach my $button (@buttonList) {
my $label;
# (Separators don't have labels, so we need to check for that)
if (! $axmud::CLIENT->toolbarLabelFlag && $button->isa('Gtk3::ToolButton')) {
$button->set_label(undef);
}
$toolbar->insert($button, -1);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# Update IVs
$self->ivAdd('buttonSetHash', $currentSet, FALSE);
$self->ivAdd('buttonSetHash', $nextSet, TRUE);
$self->ivAdd('toolbarHash', $toolbar, $nextSet);
$self->ivPoke('toolbarButtonList', @buttonList);
$self->ivPoke('toolbarOriginalSet', $nextSet);
# Not worth calling $self->redrawWidgets, so must do a ->show_all()
$toolbar->show_all();
return 1;
}
sub addToolbar {
# Called by a ->signal_connect in $self->drawToolbar whenever the user clicks the original
# toolbar's add button
# Creates a popup menu containing all of the button sets that aren't currently visible, then
# imlements the user's choice
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
@list,
%hash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addToolbar', @_);
}
# Get a list of button sets that aren't already visible
# NB The 'default' set can only be viewed in the original (first) toolbar, so it's not added
# to this list
foreach my $set ($self->constButtonSetList) {
my $descrip = $self->ivShow('constButtonDescripHash', $set);
if ($set ne $self->constToolbarDefaultSet && ! $self->ivShow('buttonSetHash', $set)) {
push (@list, $descrip);
$hash{$descrip} = $set;
}
}
if (! @list) {
# All button sets are visible (this shouldn't happen)
return undef;
}
# Set up the popup menu
my $popupMenu = Gtk3::Menu->new();
if (! $popupMenu) {
return undef;
}
# Add a title menu item, which does nothing
my $title_item = Gtk3::MenuItem->new('Add button set:');
$title_item->signal_connect('activate' => sub {
return undef;
});
$title_item->set_sensitive(FALSE);
$popupMenu->append($title_item);
$popupMenu->append(Gtk3::SeparatorMenuItem->new()); # Separator
# Fill the popup menu with button sets
foreach my $descrip (@list) {
my $menu_item = Gtk3::MenuItem->new($descrip);
$menu_item->signal_connect('activate' => sub {
# Add the set to the world model's list of button sets...
$self->worldModelObj->add_buttonSet($hash{$descrip});
# ...then redraw the window component containing the toolbar(s)
$self->redrawWidgets('toolbar');
});
$popupMenu->append($menu_item);
}
# Also add a 'Cancel' menu item, which does nothing
$popupMenu->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $cancel_item = Gtk3::MenuItem->new('Cancel');
$cancel_item->signal_connect('activate' => sub {
return undef;
});
$popupMenu->append($cancel_item);
# Display the popup menu
$popupMenu->popup(
undef, undef, undef, undef,
1, # Left mouse button
Gtk3::get_current_event_time(),
);
$popupMenu->show_all();
# Operation complete. Now wait for the user's response
return 1;
}
sub removeToolbar {
# Called by a ->signal_connect in $self->drawToolbar whenever the user clicks on the remove
# button in any toolbar except the original one
# Removes the specified toolbar and updates IVs
#
# Expected arguments
# $toolbar - The toolbar widget to be removed
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my (
$set,
@modList,
);
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->removeToolbar', @_);
}
# Check the toolbar widget still exists (no reason it shouldn't, but it doesn't hurt to
# check)
if (! $self->ivExists('toolbarHash', $toolbar)) {
return undef;
} else {
# Get the button set that was drawn in this toolbar
$set = $self->ivShow('toolbarHash', $toolbar);
}
# Add the set to the world model's list of button sets...
$self->worldModelObj->del_buttonSet($set);
# ...then redraw the window component containing the toolbar(s)
$self->redrawWidgets('toolbar');
return 1;
}
sub chooseButtonSet {
# Called by $self->drawToolbar and ->switchToolbarButtons
# Calls the right function for the specified button set, and returns the result
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
# $set - The button set to use (one of the items in $self->constButtonSetList)
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $toolbar, $set, $check) = @_;
# Local variables
my @emptyList;
# Check for improper arguments
if (! defined $toolbar || ! defined $set || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->chooseButtonSet', @_);
return @emptyList;
}
if ($set eq 'default') {
return $self->drawDefaultButtonSet($toolbar);
} elsif ($set eq 'exits') {
return $self->drawExitsButtonSet($toolbar);
} elsif ($set eq 'painting') {
return $self->drawPaintingButtonSet($toolbar);
} elsif ($set eq 'quick') {
return $self->drawQuickButtonSet($toolbar);
} elsif ($set eq 'background') {
return $self->drawBackgroundButtonSet($toolbar);
} elsif ($set eq 'tracking') {
return $self->drawTrackingButtonSet($toolbar);
} elsif ($set eq 'misc') {
return $self->drawMiscButtonSet($toolbar);
} elsif ($set eq 'flags') {
return $self->drawFlagsButtonSet($toolbar);
} elsif ($set eq 'interiors') {
return $self->drawInteriorsButtonSet($toolbar);
} else {
return @emptyList;
}
}
sub drawDefaultButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my @buttonList;
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawDefaultButtonSet', @_);
}
# Radio button for 'wait mode'
my $radioButton_waitMode = Gtk3::RadioToolButton->new(undef);
if ($self->mode eq 'wait') {
$radioButton_waitMode->set_active(TRUE);
}
$radioButton_waitMode->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_wait.png')
);
$radioButton_waitMode->set_label('Wait mode');
$radioButton_waitMode->set_tooltip_text('Wait mode');
$radioButton_waitMode->signal_connect('toggled' => sub {
# (To stop the equivalent menu item from being toggled by the call to ->setMode, make
# use of $self->ignoreMenuUpdateFlag)
if ($radioButton_waitMode->get_active && ! $self->ignoreMenuUpdateFlag) {
$self->setMode('wait');
}
});
push (@buttonList, $radioButton_waitMode);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_set_wait_mode', $radioButton_waitMode);
# Radio button for 'follow mode'
my $radioButton_followMode = Gtk3::RadioToolButton->new_from_widget($radioButton_waitMode);
if ($self->mode eq 'follow') {
$radioButton_followMode->set_active(TRUE);
}
$radioButton_followMode->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_follow.png')
);
$radioButton_followMode->set_label('Follow mode');
$radioButton_followMode->set_tooltip_text('Follow mode');
$radioButton_followMode->signal_connect('toggled' => sub {
if ($radioButton_followMode->get_active && ! $self->ignoreMenuUpdateFlag) {
$self->setMode('follow');
}
});
push (@buttonList, $radioButton_followMode);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_set_follow_mode', $radioButton_followMode);
# Radio button for 'update' mode
my $radioButton_updateMode = Gtk3::RadioToolButton->new_from_widget(
$radioButton_followMode,
);
if ($self->mode eq 'update') {
$radioButton_updateMode->set_active(TRUE);
}
$radioButton_updateMode->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_update.png')
);
$radioButton_updateMode->set_label('Update mode');
$radioButton_updateMode->set_tooltip_text('Update mode');
$radioButton_updateMode->signal_connect('toggled' => sub {
if ($radioButton_updateMode->get_active && ! $self->ignoreMenuUpdateFlag) {
$self->setMode('update');
}
});
push (@buttonList, $radioButton_updateMode);
# (Requires $self->currentRegionmap, GA::Obj::WorldModel->disableUpdateModeFlag set to
# FALSE and a session not in 'connect offline' mode
$self->ivAdd('menuToolItemHash', 'icon_set_update_mode', $radioButton_updateMode);
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
# Toolbutton for 'move up level'
my $toolButton_moveUpLevel = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_move_up.png'),
'Move up level',
);
$toolButton_moveUpLevel->set_tooltip_text('Move up level');
$toolButton_moveUpLevel->signal_connect('clicked' => sub {
$self->setCurrentLevel($self->currentRegionmap->currentLevel + 1);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
});
push (@buttonList, $toolButton_moveUpLevel);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_move_up_level', $toolButton_moveUpLevel);
# Toolbutton for 'move down level'
my $toolButton_moveDownLevel = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_move_down.png'),
'Move down level',
);
$toolButton_moveDownLevel->set_tooltip_text('Move down level');
$toolButton_moveDownLevel->signal_connect('clicked' => sub {
$self->setCurrentLevel($self->currentRegionmap->currentLevel - 1);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
});
push (@buttonList, $toolButton_moveDownLevel);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_move_down_level', $toolButton_moveDownLevel);
# Separator
my $separator2 = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator2);
# Toolbutton for 'reset locator'
my $toolButton_resetLocator = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_reset_locator.png'),
'Reset Locator task',
);
$toolButton_resetLocator->set_tooltip_text('Reset locator task');
$toolButton_resetLocator->signal_connect('clicked' => sub {
$self->resetLocatorCallback();
});
push (@buttonList, $toolButton_resetLocator);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_reset_locator', $toolButton_resetLocator);
# Toolbutton for 'set current room'
my $toolButton_setCurrentRoom = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_set.png'),
'Set current room',
);
$toolButton_setCurrentRoom->set_tooltip_text('Set current room');
$toolButton_setCurrentRoom->signal_connect('clicked' => sub {
$self->mapObj->setCurrentRoom($self->selectedRoom);
});
push (@buttonList, $toolButton_setCurrentRoom);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'icon_set_current_room', $toolButton_setCurrentRoom);
# Toolbutton for 'set failed exit'
my $toolButton_setFailedExit = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_fail_exit.png'),
'Set failed exit',
);
$toolButton_setFailedExit->set_tooltip_text('Set failed exit');
$toolButton_setFailedExit->signal_connect('clicked' => sub {
$self->session->pseudoCmd('insertfailexit');
});
push (@buttonList, $toolButton_setFailedExit);
# (Requires $self->currentRegionmap and a current room
$self->ivAdd('menuToolItemHash', 'icon_fail_exit', $toolButton_setFailedExit);
# Toggle button for 'drag mode'
my $toggleButton_dragMode = Gtk3::ToggleToolButton->new();
$toggleButton_dragMode->set_active($self->dragModeFlag);
$toggleButton_dragMode->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_drag_mode.png'),
);
$toggleButton_dragMode->set_label('Drag mode');
$toggleButton_dragMode->set_tooltip_text('Drag mode');
$toggleButton_dragMode->signal_connect('toggled' => sub {
if ($toggleButton_dragMode->get_active()) {
$self->ivPoke('dragModeFlag', TRUE);
} else {
$self->ivPoke('dragModeFlag', FALSE);
}
# Set the equivalent menu item
if ($self->ivExists('menuToolItemHash', 'drag_mode')) {
my $menuItem = $self->ivShow('menuToolItemHash', 'drag_mode');
$menuItem->set_active($self->dragModeFlag);
}
});
push (@buttonList, $toggleButton_dragMode);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_drag_mode', $toggleButton_dragMode);
# Toolbutton for 'move selected rooms to click'
my $toolButton_moveClick = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_move_click.png'),
'Move selected rooms to click',
);
$toolButton_moveClick->set_tooltip_text('Move selected rooms to click');
$toolButton_moveClick->signal_connect('clicked' => sub {
# Set the free clicking mode: $self->mouseClickEvent will move the objects when the
# user next clicks on an empty part of the map
$self->set_freeClickMode('move_room');
});
push (@buttonList, $toolButton_moveClick);
# (Requires $self->currentRegionmap and one or more selected rooms)
$self->ivAdd('menuToolItemHash', 'icon_move_to_click', $toolButton_moveClick);
# Toolbutton for 'connect to click'
my $toolButton_connectClick = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_connect_click.png'),
'Connect selected exit to room',
);
$toolButton_connectClick->set_tooltip_text('Connect selected exit to room');
$toolButton_connectClick->signal_connect('clicked' => sub {
$self->connectToClickCallback();
});
push (@buttonList, $toolButton_connectClick);
# (Requires $self->currentRegionmap, $self->selectedExit and
# $self->selectedExit->drawMode is 'primary', 'temp_unalloc' or 'perm_alloc')
$self->ivAdd('menuToolItemHash', 'icon_connect_click', $toolButton_connectClick);
# Toolbutton for 'take screenshot'
my $toolButton_visibleScreenshot = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_take_screenshot.png'),
'Take screenshot of visible map',
);
$toolButton_visibleScreenshot->set_tooltip_text('Take screenshot of visible map');
$toolButton_visibleScreenshot->signal_connect('clicked' => sub {
$self->regionScreenshotCallback('visible');
});
push (@buttonList, $toolButton_visibleScreenshot);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_visible_screenshot', $toolButton_visibleScreenshot);
return @buttonList;
}
sub drawExitsButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my @buttonList;
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawExitsButtonSet', @_);
}
# Radio button for 'use region exit settings' mode
my $radioButton_deferDrawExits = Gtk3::RadioToolButton->new(undef);
$radioButton_deferDrawExits->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_use_region.png'),
);
$radioButton_deferDrawExits->set_label('Use region exit settings');
$radioButton_deferDrawExits->set_tooltip_text('Use region exit settings');
$radioButton_deferDrawExits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton_deferDrawExits->get_active()) {
$self->worldModelObj->switchMode(
'drawExitMode',
'ask_regionmap', # New value of ->drawExitMode
TRUE, # Do call $self->redrawRegions
'draw_defer_exits',
'icon_draw_defer_exits',
);
}
});
push (@buttonList, $radioButton_deferDrawExits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_draw_defer_exits', $radioButton_deferDrawExits);
# Radio button for 'draw no exits' mode
my $radioButton_drawNoExits = Gtk3::RadioToolButton->new_from_widget(
$radioButton_deferDrawExits,
);
if ($self->worldModelObj->drawExitMode eq 'no_exit') {
$radioButton_drawNoExits->set_active(TRUE);
}
$radioButton_drawNoExits->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_draw_none.png'),
);
$radioButton_drawNoExits->set_label('Draw no exits');
$radioButton_drawNoExits->set_tooltip_text('Draw no exits');
$radioButton_drawNoExits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton_drawNoExits->get_active()) {
$self->worldModelObj->switchMode(
'drawExitMode',
'no_exit', # New value of ->drawExitMode
TRUE, # Do call $self->redrawRegions
'draw_no_exits',
'icon_draw_no_exits',
);
}
});
push (@buttonList, $radioButton_drawNoExits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_draw_no_exits', $radioButton_drawNoExits);
# Radio button for 'draw simple exits' mode
my $radioButton_drawSimpleExits = Gtk3::RadioToolButton->new_from_widget(
$radioButton_drawNoExits,
);
if ($self->worldModelObj->drawExitMode eq 'simple_exit') {
$radioButton_drawSimpleExits->set_active(TRUE);
}
$radioButton_drawSimpleExits->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_draw_simple.png'),
);
$radioButton_drawSimpleExits->set_label('Draw simple exits');
$radioButton_drawSimpleExits->set_tooltip_text('Draw simple exits');
$radioButton_drawSimpleExits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton_drawSimpleExits->get_active()) {
$self->worldModelObj->switchMode(
'drawExitMode',
'simple_exit', # New value of ->drawExitMode
TRUE, # Do call $self->redrawRegions
'draw_simple_exits',
'icon_draw_simple_exits',
);
}
});
push (@buttonList, $radioButton_drawSimpleExits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_draw_simple_exits', $radioButton_drawSimpleExits);
# Radio button for 'draw complex exits' mode
my $radioButton_drawComplexExits = Gtk3::RadioToolButton->new_from_widget(
$radioButton_drawSimpleExits,
);
if ($self->worldModelObj->drawExitMode eq 'complex_exit') {
$radioButton_drawComplexExits->set_active(TRUE);
}
$radioButton_drawComplexExits->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_draw_complex.png'),
);
$radioButton_drawComplexExits->set_label('Draw complex exits');
$radioButton_drawComplexExits->set_tooltip_text('Draw complex exits');
$radioButton_drawComplexExits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton_drawComplexExits->get_active()) {
$self->worldModelObj->switchMode(
'drawExitMode',
'complex_exit', # New value of ->drawExitMode
TRUE, # Do call $self->redrawRegions
'draw_complex_exits',
'icon_draw_complex_exits',
);
}
});
push (@buttonList, $radioButton_drawComplexExits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_draw_complex_exits', $radioButton_drawComplexExits);
# Toggle button for 'obscure unimportant exits'
my $toggleButton_obscuredExits = Gtk3::ToggleToolButton->new();
$toggleButton_obscuredExits->set_active($self->worldModelObj->obscuredExitFlag);
$toggleButton_obscuredExits->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_obscured_exits.png'),
);
$toggleButton_obscuredExits->set_label('Obscure unimportant exits');
$toggleButton_obscuredExits->set_tooltip_text('Obscure unimportant exits');
$toggleButton_obscuredExits->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'obscuredExitFlag',
$toggleButton_obscuredExits->get_active(),
TRUE, # Do call $self->redrawRegions
'obscured_exits',
'icon_obscured_exits',
);
}
});
push (@buttonList, $toggleButton_obscuredExits);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_obscured_exits', $toggleButton_obscuredExits);
# Toggle button for 'auto-redraw obscured exits'
my $toggleButton_autoRedraw = Gtk3::ToggleToolButton->new();
$toggleButton_autoRedraw->set_active($self->worldModelObj->obscuredExitRedrawFlag);
$toggleButton_autoRedraw->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_auto_redraw.png'),
);
$toggleButton_autoRedraw->set_label('Auto-redraw obscured exits');
$toggleButton_autoRedraw->set_tooltip_text('Auto-redraw obscured exits');
$toggleButton_autoRedraw->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'obscuredExitRedrawFlag',
$toggleButton_autoRedraw->get_active(),
TRUE, # Do call $self->redrawRegions
'auto_redraw_obscured',
'icon_auto_redraw_obscured',
);
}
});
push (@buttonList, $toggleButton_autoRedraw);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_auto_redraw_obscured', $toggleButton_autoRedraw);
# Toolbutton for 'obscure exits in radius'
my $toolButton_obscuredRadius = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_obscured_radius.png'),
'Obscure exits in radius',
);
$toolButton_obscuredRadius->set_tooltip_text('Obscure exits in radius');
$toolButton_obscuredRadius->signal_connect('clicked' => sub {
$self->obscuredRadiusCallback();
});
push (@buttonList, $toolButton_obscuredRadius);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_obscured_radius', $toolButton_obscuredRadius);
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
# Toolbutton for 'horizontal exit length'
my $toolButton_horizontalLengths = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR
. '/icons/map/icon_horizontal_lengths.png'),
'Horizontal exit length',
);
$toolButton_horizontalLengths->set_tooltip_text('Horizontal exit length');
$toolButton_horizontalLengths->signal_connect('clicked' => sub {
$self->setExitLengthCallback('horizontal');
});
push (@buttonList, $toolButton_horizontalLengths);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_horizontal_lengths', $toolButton_horizontalLengths);
# Toolbutton for 'vertical exit length'
my $toolButton_verticalLengths = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR
. '/icons/map/icon_vertical_lengths.png'),
'Vertical exit length',
);
$toolButton_verticalLengths->set_tooltip_text('Vertical exit length');
$toolButton_verticalLengths->signal_connect('clicked' => sub {
$self->setExitLengthCallback('vertical');
});
push (@buttonList, $toolButton_verticalLengths);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_vertical_lengths', $toolButton_verticalLengths);
# Separator
my $separator2 = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator2);
# Toggle button for 'draw exit ornaments'
my $toggleButton_drawExitOrnaments = Gtk3::ToggleToolButton->new();
$toggleButton_drawExitOrnaments->set_active($self->worldModelObj->drawOrnamentsFlag);
$toggleButton_drawExitOrnaments->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_draw_ornaments.png'),
);
$toggleButton_drawExitOrnaments->set_label('Draw exit ornaments');
$toggleButton_drawExitOrnaments->set_tooltip_text('Draw exit ornaments');
$toggleButton_drawExitOrnaments->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'drawOrnamentsFlag',
$toggleButton_drawExitOrnaments->get_active(),
TRUE, # Do call $self->redrawRegions
'draw_ornaments',
'icon_draw_ornaments',
);
}
});
push (@buttonList, $toggleButton_drawExitOrnaments);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_draw_ornaments', $toggleButton_drawExitOrnaments);
# Toolbutton for 'no ornament'
my $toolButton_noOrnament = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_no_ornament.png'),
'Set no ornament',
);
$toolButton_noOrnament->set_tooltip_text('Set no ornament');
$toolButton_noOrnament->signal_connect('clicked' => sub {
$self->exitOrnamentCallback('none');
});
push (@buttonList, $toolButton_noOrnament);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'icon_no_ornament', $toolButton_noOrnament);
# Separator
my $separator3 = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator3);
# Toolbutton for 'openable exit'
my $toolButton_openableExit = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_openable_exit.png'),
'Set openable exit',
);
$toolButton_openableExit->set_tooltip_text('Set openable exit');
$toolButton_openableExit->signal_connect('clicked' => sub {
$self->exitOrnamentCallback('open');
});
push (@buttonList, $toolButton_openableExit);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'icon_openable_exit', $toolButton_openableExit);
# Toolbutton for 'lockable exit'
my $toolButton_lockableExit = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_lockable_exit.png'),
'Set lockable exit',
);
$toolButton_lockableExit->set_tooltip_text('Set lockable exit');
$toolButton_lockableExit->signal_connect('clicked' => sub {
$self->exitOrnamentCallback('lock');
});
push (@buttonList, $toolButton_lockableExit);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'icon_lockable_exit', $toolButton_lockableExit);
# Toolbutton for 'pickable exit'
my $toolButton_pickableExit = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_pickable_exit.png'),
'Set pickable exit',
);
$toolButton_pickableExit->set_tooltip_text('Set pickable exit');
$toolButton_pickableExit->signal_connect('clicked' => sub {
$self->exitOrnamentCallback('pick');
});
push (@buttonList, $toolButton_pickableExit);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'icon_pickable_exit', $toolButton_pickableExit);
# Toolbutton for 'breakable exit'
my $toolButton_breakableExit = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_breakable_exit.png'),
'Set breakable exit',
);
$toolButton_breakableExit->set_tooltip_text('Set breakable exit');
$toolButton_breakableExit->signal_connect('clicked' => sub {
$self->exitOrnamentCallback('break');
});
push (@buttonList, $toolButton_breakableExit);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'icon_breakable_exit', $toolButton_breakableExit);
# Toolbutton for 'impassable exit'
my $toolButton_impassableExit = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_impassable_exit.png'),
'Set impassable exit',
);
$toolButton_impassableExit->set_tooltip_text('Set impassable exit');
$toolButton_impassableExit->signal_connect('clicked' => sub {
$self->exitOrnamentCallback('impass');
});
push (@buttonList, $toolButton_impassableExit);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'icon_impassable_exit', $toolButton_impassableExit);
# Toolbutton for 'mystery exit'
my $toolButton_mysteryExit = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_mystery_exit.png'),
'Set mystery exit',
);
$toolButton_mysteryExit->set_tooltip_text('Set mystery exit');
$toolButton_mysteryExit->signal_connect('clicked' => sub {
$self->exitOrnamentCallback('mystery');
});
push (@buttonList, $toolButton_mysteryExit);
# (Requires $self->currentRegionmap & either $self->selectedExit or
# $self->selectedExitHash)
$self->ivAdd('menuToolItemHash', 'icon_mystery_exit', $toolButton_mysteryExit);
return @buttonList;
}
sub drawPaintingButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my (
@buttonList,
%oldHash,
);
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawPaintingButtonSet', @_);
}
# This hash must be reset whenever the toolbar is redrawn. Make a temporary copy, so any
# colour buttons can remain toggled, if they were toggled before being drawn
%oldHash = $self->toolbarRoomFlagHash;
$self->ivEmpty('toolbarRoomFlagHash');
# Toggle button for 'enable painter'
my $toggleButton_enablePainter = Gtk3::ToggleToolButton->new();
$toggleButton_enablePainter->set_active($self->painterFlag);
$toggleButton_enablePainter->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_enable_painter.png'),
);
$toggleButton_enablePainter->set_label('Enable painter');
$toggleButton_enablePainter->set_tooltip_text('Enable painter');
$toggleButton_enablePainter->signal_connect('toggled' => sub {
my $item;
# Toggle the flag
if ($toggleButton_enablePainter->get_active()) {
$self->ivPoke('painterFlag', TRUE);
} else {
$self->ivPoke('painterFlag', FALSE);
}
# Update the corresponding menu item
$item = $self->ivShow('menuToolItemHash', 'enable_painter');
if ($item) {
$item->set_active($self->painterFlag);
}
});
push (@buttonList, $toggleButton_enablePainter);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_enable_painter', $toggleButton_enablePainter);
# Toolbutton for 'edit painter'
my $toolButton_editPainter = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_edit_painter.png'),
'Edit painter',
);
$toolButton_editPainter->set_tooltip_text('Edit painter');
$toolButton_editPainter->signal_connect('clicked' => sub {
# Open an 'edit' window for the painter object
$self->createFreeWin(
'Games::Axmud::EditWin::Painter',
$self,
$self->session,
'Edit world model painter',
$self->worldModelObj->painterObj,
FALSE, # Not temporary
);
});
push (@buttonList, $toolButton_editPainter);
# Radio button for 'paint all rooms'
my $radioButton_paintAllRooms = Gtk3::RadioToolButton->new(undef);
$radioButton_paintAllRooms->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_paint_all.png'),
);
$radioButton_paintAllRooms->set_label('Paint all rooms');
$radioButton_paintAllRooms->set_tooltip_text('Paint all rooms');
$radioButton_paintAllRooms->signal_connect('toggled' => sub {
if ($radioButton_paintAllRooms->get_active()) {
$self->worldModelObj->set_paintAllRoomsFlag(TRUE);
# Set the equivalent menu item
if ($self->ivExists('menuToolItemHash', 'paint_all')) {
$self->ivShow('menuToolItemHash', 'paint_all')->set_active(TRUE);
}
}
});
push (@buttonList, $radioButton_paintAllRooms);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_paint_all', $radioButton_paintAllRooms);
# Radio button for 'paint only new rooms'
my $radioButton_paintNewRooms = Gtk3::RadioToolButton->new_from_widget(
$radioButton_paintAllRooms,
);
if (! $self->worldModelObj->paintAllRoomsFlag) {
$radioButton_paintNewRooms->set_active(TRUE);
}
$radioButton_paintNewRooms->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_paint_new.png'),
);
$radioButton_paintNewRooms->set_label('Paint only new rooms');
$radioButton_paintNewRooms->set_tooltip_text('Paint only new rooms');
$radioButton_paintNewRooms->signal_connect('toggled' => sub {
if ($radioButton_paintNewRooms->get_active) {
$self->worldModelObj->set_paintAllRoomsFlag(FALSE);
# Set the equivalent menu item
if ($self->ivExists('menuToolItemHash', 'paint_new')) {
$self->ivShow('menuToolItemHash', 'paint_new')->set_active(TRUE);
}
}
});
push (@buttonList, $radioButton_paintNewRooms);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_paint_new', $radioButton_paintNewRooms);
# Radio button for 'paint normal rooms'
my $radioButton_paintNormalRooms = Gtk3::RadioToolButton->new(undef);
$radioButton_paintNormalRooms->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_paint_normal.png'),
);
$radioButton_paintNormalRooms->set_label('Paint normal rooms');
$radioButton_paintNormalRooms->set_tooltip_text('Paint normal rooms');
$radioButton_paintNormalRooms->signal_connect('toggled' => sub {
if ($radioButton_paintNormalRooms->get_active()) {
$self->worldModelObj->painterObj->ivPoke('wildMode', 'normal');
# Set the equivalent menu item
if ($self->ivExists('menuToolItemHash', 'paint_normal')) {
$self->ivShow('menuToolItemHash', 'paint_normal')->set_active(TRUE);
}
}
});
push (@buttonList, $radioButton_paintNormalRooms);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_paint_normal', $radioButton_paintNormalRooms);
# Radio button for 'paint wilderness rooms'
my $radioButton_paintWildRooms = Gtk3::RadioToolButton->new_from_widget(
$radioButton_paintNormalRooms,
);
if ($self->worldModelObj->painterObj->wildMode eq 'wild') {
$radioButton_paintWildRooms->set_active(TRUE);
}
$radioButton_paintWildRooms->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_paint_wild.png'),
);
$radioButton_paintWildRooms->set_label('Paint wilderness rooms');
$radioButton_paintWildRooms->set_tooltip_text('Paint wilderness rooms');
$radioButton_paintWildRooms->signal_connect('toggled' => sub {
if ($radioButton_paintWildRooms->get_active) {
$self->worldModelObj->painterObj->ivPoke('wildMode', 'wild');
# Set the equivalent menu item
if ($self->ivExists('menuToolItemHash', 'paint_wild')) {
$self->ivShow('menuToolItemHash', 'paint_wild')->set_active(TRUE);
}
}
});
push (@buttonList, $radioButton_paintWildRooms);
# (Requires $self->session->currentWorld->basicMappingFlag to be FALSE)
$self->ivAdd('menuToolItemHash', 'icon_paint_wild', $radioButton_paintWildRooms);
# Radio button for 'paint wilderness border rooms'
my $radioButton_paintBorderRooms = Gtk3::RadioToolButton->new_from_widget(
$radioButton_paintWildRooms,
);
if ($self->worldModelObj->painterObj->wildMode eq 'border') {
$radioButton_paintBorderRooms->set_active(TRUE);
}
$radioButton_paintBorderRooms->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_paint_border.png'),
);
$radioButton_paintBorderRooms->set_label('Paint wilderness border rooms');
$radioButton_paintBorderRooms->set_tooltip_text('Paint wilderness border rooms');
$radioButton_paintBorderRooms->signal_connect('toggled' => sub {
if ($radioButton_paintBorderRooms->get_active) {
$self->worldModelObj->painterObj->ivPoke('wildMode', 'border');
# Set the equivalent menu item
if ($self->ivExists('menuToolItemHash', 'paint_border')) {
$self->ivShow('menuToolItemHash', 'paint_border')->set_active(TRUE);
}
}
});
push (@buttonList, $radioButton_paintBorderRooms);
# (Requires $self->session->currentWorld->basicMappingFlag to be FALSE)
$self->ivAdd('menuToolItemHash', 'icon_paint_border', $radioButton_paintBorderRooms);
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
my $toolButton_addRoomFlag = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_add_room_flag.png'),
'Add preferred room flag',
);
$toolButton_addRoomFlag->set_tooltip_text('Add preferred room flag');
$toolButton_addRoomFlag->signal_connect('clicked' => sub {
$self->addRoomFlagButton();
});
push (@buttonList, $toolButton_addRoomFlag);
my $toolButton_removeRoomFlag = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_remove_room_flag.png'),
'Remove preferred room flag',
);
$toolButton_removeRoomFlag->set_tooltip_text('Remove preferred room flag');
$toolButton_removeRoomFlag->signal_connect('clicked' => sub {
$self->removeRoomFlagButton();
});
push (@buttonList, $toolButton_removeRoomFlag);
# (Requires non-empty $self->worldModelObj->preferRoomFlagList)
$self->ivAdd('menuToolItemHash', 'icon_remove_room_flag', $toolButton_removeRoomFlag);
foreach my $roomFlag ($self->worldModelObj->preferRoomFlagList) {
my ($roomFlagObj, $colour, $frameColour, $text);
$roomFlagObj = $self->worldModelObj->ivShow('roomFlagHash', $roomFlag);
if ($roomFlagObj) {
$colour = $roomFlagObj->colour;
$text = $roomFlagObj->name;
}
if ($colour) {
# Convert RGB colours to Gdk RGBA
$colour =~ s/^#//;
$colour = ((hex $colour) * 256) + 255;
$frameColour = ((hex '000000') * 256) + 255;
# Create a pixbuf, with its own sub-region. Use $colour to fill the sub-region,
# leaving the renaming area of the pixbuf as a black frame
my $pixbuf = Gtk3::Gdk::Pixbuf->new(
'GDK_COLORSPACE_RGB',
FALSE,
# Same values as ->get_bits_per_sample, ->get_width, ->get_height as a
# Gtk3::Gdk::Pixbuf loaded from one of the icon files in ../share/icons/map
8,
20,
20,
);
$pixbuf->fill($frameColour);
# Create the sub-region, drawn in $colour
my $subPixbuf = $pixbuf->new_subpixbuf(1, 1, 18, 18);
$subPixbuf->fill($colour);
my $toolButton = Gtk3::ToggleToolButton->new();
if (exists $oldHash{$roomFlag}) {
$toolButton->set_active(TRUE);
# (Toggled buttons must survive the toolbar redraw)
$self->ivAdd('toolbarRoomFlagHash', $roomFlag, undef);
}
$toolButton->set_icon_widget(
Gtk3::Image->new_from_pixbuf($pixbuf),
);
$toolButton->set_label($text);
$toolButton->set_tooltip_text($text);
$toolButton->signal_connect('toggled' => sub {
# Add or remove the room flag from the painter
if (! $toolButton->get_active()) {
$self->worldModelObj->painterObj->ivDelete('roomFlagHash', $roomFlag);
# (Entries in this hash may or may not exist in the painter's hash)
$self->ivDelete('toolbarRoomFlagHash', $roomFlag);
} else {
$self->worldModelObj->painterObj->ivAdd('roomFlagHash', $roomFlag);
$self->ivAdd('toolbarRoomFlagHash', $roomFlag, undef);
}
});
push (@buttonList, $toolButton);
}
}
return @buttonList;
}
sub drawQuickButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my (
$ignoreFlag,
@buttonList, @colourButtonList,
%oldHash,
);
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawPaintingButtonSet', @_);
}
# This hash must be reset whenever the toolbar is redrawn. Make a temporary copy, so any
# colour buttons can remain toggled, if they were toggled before being drawn
%oldHash = $self->toolbarRoomFlagHash;
$self->ivEmpty('toolbarRoomFlagHash');
# Radio button for 'paint all rooms'
my $radioButton_quickSingle = Gtk3::RadioToolButton->new(undef);
$radioButton_quickSingle->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_quick_single.png'),
);
$radioButton_quickSingle->set_label('Quick paint then reset');
$radioButton_quickSingle->set_tooltip_text('Quick paint then reset');
$radioButton_quickSingle->signal_connect('toggled' => sub {
if ($radioButton_quickSingle->get_active()) {
$self->worldModelObj->set_quickPaintMultiFlag(FALSE);
foreach my $button (@colourButtonList) {
$button->set_active(FALSE);
}
}
});
push (@buttonList, $radioButton_quickSingle);
# Radio button for 'paint only new rooms'
my $radioButton_quickMulti = Gtk3::RadioToolButton->new_from_widget(
$radioButton_quickSingle,
);
if ($self->worldModelObj->quickPaintMultiFlag) {
$radioButton_quickMulti->set_active(TRUE);
}
$radioButton_quickMulti->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_quick_multi.png'),
);
$radioButton_quickMulti->set_label('Quick paint without resetting');
$radioButton_quickMulti->set_tooltip_text('Quick paint without resetting');
$radioButton_quickMulti->signal_connect('toggled' => sub {
if ($radioButton_quickMulti->get_active) {
$self->worldModelObj->set_quickPaintMultiFlag(TRUE);
}
});
push (@buttonList, $radioButton_quickMulti);
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
my $toolButton_addRoomFlag = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_add_quick_flag.png'),
'Add preferred room flag',
);
$toolButton_addRoomFlag->set_tooltip_text('Add preferred room flag');
$toolButton_addRoomFlag->signal_connect('clicked' => sub {
$self->addRoomFlagButton();
});
push (@buttonList, $toolButton_addRoomFlag);
my $toolButton_removeRoomFlag = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_remove_quick_flag.png'),
'Remove preferred room flag',
);
$toolButton_removeRoomFlag->set_tooltip_text('Remove preferred room flag');
$toolButton_removeRoomFlag->signal_connect('clicked' => sub {
$self->removeRoomFlagButton();
});
push (@buttonList, $toolButton_removeRoomFlag);
# (Requires non-empty $self->worldModelObj->preferRoomFlagList)
$self->ivAdd('menuToolItemHash', 'icon_remove_room_flag_2', $toolButton_removeRoomFlag);
foreach my $roomFlag ($self->worldModelObj->preferRoomFlagList) {
my ($roomFlagObj, $colour, $frameColour, $text);
$roomFlagObj = $self->worldModelObj->ivShow('roomFlagHash', $roomFlag);
if ($roomFlagObj) {
$colour = $roomFlagObj->colour;
$text = $roomFlagObj->name;
}
if ($colour) {
# Convert RGB colours to Gdk RGBA
$colour =~ s/^#//;
$colour = ((hex $colour) * 256) + 255;
$frameColour = ((hex '000000') * 256) + 255;
# Create a pixbuf, with its own sub-region. Use $colour to fill the sub-region,
# leaving the renaming area of the pixbuf as a black frame
my $pixbuf = Gtk3::Gdk::Pixbuf->new(
'GDK_COLORSPACE_RGB',
FALSE,
# Same values as ->get_bits_per_sample, ->get_width, ->get_height as a
# Gtk3::Gdk::Pixbuf loaded from one of the icon files in ../share/icons/map
8,
20,
20,
);
$pixbuf->fill($frameColour);
# Create the sub-region, drawn in $colour
my $subPixbuf = $pixbuf->new_subpixbuf(1, 1, 18, 18);
$subPixbuf->fill($colour);
my $toolButton = Gtk3::ToggleToolButton->new();
if (exists $oldHash{$roomFlag}) {
$toolButton->set_active(TRUE);
# (Toggled buttons must survive the toolbar redraw)
$self->ivAdd('toolbarRoomFlagHash', $roomFlag, undef);
}
$toolButton->set_icon_widget(
Gtk3::Image->new_from_pixbuf($pixbuf),
);
$toolButton->set_label($text);
$toolButton->set_tooltip_text($text);
$toolButton->signal_connect('toggled' => sub {
# Add or remove the room flag from hash IV, so that $self->doQuickPaint knows to
# use it (or not to use it)
if (! $ignoreFlag) {
# If this button has been toggled by the user, other buttons might receive
# the same signal; tell their ->signal_connect to ignore it
$ignoreFlag = TRUE;
if (! $toolButton->get_active()) {
$self->ivUndef('toolbarQuickPaintColour');
} else {
$self->ivPoke('toolbarQuickPaintColour', $roomFlag);
# When this colour button is selected, deselect all the other colour
# buttons
# (If the $radioButton_quickSingle button is selected, also deselect
# this button, as the user wants the choice of room flag to reset
# as soon as they click on a room)
foreach my $otherButton (@colourButtonList) {
if (
$radioButton_quickSingle->get_active()
|| $otherButton ne $toolButton
) {
$otherButton->set_active(FALSE);
}
}
}
$ignoreFlag = FALSE;
}
});
push (@buttonList, $toolButton);
# Only one of the colour buttons should be toggled at a time. Don't use radio
# buttons because we want it to be possible for none of the colour buttons to be
# selected
push (@colourButtonList, $toolButton);
}
}
return @buttonList;
}
sub drawBackgroundButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my @buttonList;
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->drawBackgroundButtonSet',
@_,
);
}
# Radio button for 'no background colouring'
my $radioButton_bgDefault = Gtk3::RadioToolButton->new(undef);
if ($self->bgColourMode eq 'default') {
$radioButton_bgDefault->set_active(TRUE);
}
$radioButton_bgDefault->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_bg_default.png')
);
$radioButton_bgDefault->set_label('No background colouring');
$radioButton_bgDefault->set_tooltip_text('No background colouring');
$radioButton_bgDefault->signal_connect('toggled' => sub {
my $item;
# Update the IVs
if ($radioButton_bgDefault->get_active()) {
$self->ivPoke('bgColourMode', 'default');
$self->ivUndef('bgRectXPos');
$self->ivUndef('bgRectYPos');
# Make sure any free click mode operations, like connecting exits or moving rooms,
# are cancelled
$self->reset_freeClickMode();
}
});
push (@buttonList, $radioButton_bgDefault);
# Radio button for 'colour single blocks'
my $radioButton_bgColour = Gtk3::RadioToolButton->new_from_widget($radioButton_bgDefault);
if ($self->bgColourMode eq 'square_start') {
$radioButton_bgColour->set_active(TRUE);
}
$radioButton_bgColour->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_bg_colour.png')
);
$radioButton_bgColour->set_label('Colour single blocks');
$radioButton_bgColour->set_tooltip_text('Colour single blocks');
$radioButton_bgColour->signal_connect('toggled' => sub {
my $item;
# Update the IV
if ($radioButton_bgColour->get_active()) {
$self->ivPoke('bgColourMode', 'square_start');
# Make sure any free click mode operations, like connecting exits or moving rooms,
# are cancelled
$self->reset_freeClickMode();
}
});
push (@buttonList, $radioButton_bgColour);
# Radio button for 'colour multiple blocks'
my $radioButton_bgShape = Gtk3::RadioToolButton->new_from_widget($radioButton_bgDefault);
if ($self->bgColourMode eq 'rect_start' || $self->bgColourMode eq 'rect_stop') {
$radioButton_bgShape->set_active(TRUE);
}
$radioButton_bgShape->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_bg_shape.png')
);
$radioButton_bgShape->set_label('Colour multiple blocks');
$radioButton_bgShape->set_tooltip_text('Colour multiple blocks');
$radioButton_bgShape->signal_connect('toggled' => sub {
my $item;
# Update the IV
if ($radioButton_bgShape->get_active()) {
$self->ivPoke('bgColourMode', 'rect_start');
# Make sure any free click mode operations, like connecting exits or moving rooms,
# are cancelled
$self->reset_freeClickMode();
}
});
push (@buttonList, $radioButton_bgShape);
# Toggle button for 'colour on all levels'
my $toggleButton_colourAllLevel = Gtk3::ToggleToolButton->new();
$toggleButton_colourAllLevel->set_active($self->bgAllLevelFlag);
$toggleButton_colourAllLevel->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_colour_all_level.png'),
);
$toggleButton_colourAllLevel->set_label('Colour on all levels');
$toggleButton_colourAllLevel->set_tooltip_text('Colour on all levels');
$toggleButton_colourAllLevel->signal_connect('toggled' => sub {
# Update the IV
if ($toggleButton_colourAllLevel->get_active()) {
$self->ivPoke('bgAllLevelFlag', TRUE);
} else {
$self->ivPoke('bgAllLevelFlag', FALSE);
}
});
push (@buttonList, $toggleButton_colourAllLevel);
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
# Toolbutton for 'add background colour'
my $toolButton_addColour = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_bg_add.png'),
'Add background colour',
);
$toolButton_addColour->set_tooltip_text('Add background colour');
$toolButton_addColour->signal_connect('clicked' => sub {
$self->addBGColourButton();
});
push (@buttonList, $toolButton_addColour);
# Toolbutton for 'remove background colour'
my $toolButton_removeColour = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_bg_remove.png'),
'Remove background colour',
);
$toolButton_removeColour->set_tooltip_text('Remove background colour');
$toolButton_removeColour->signal_connect('clicked' => sub {
$self->removeBGColourButton();
});
push (@buttonList, $toolButton_removeColour);
# (Requires non-empty $self->worldModelObj->preferBGColourList)
$self->ivAdd('menuToolItemHash', 'icon_bg_remove', $toolButton_removeColour);
# Radiobutton for 'use default colour'
my $radioButton_useDefault = Gtk3::RadioToolButton->new(undef);
if (! defined $self->bgColourChoice) {
$radioButton_useDefault->set_active(TRUE);
}
$radioButton_useDefault->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_bg_blank.png'),
);
$radioButton_useDefault->set_label('No background colouring');
$radioButton_useDefault->set_tooltip_text('No background colouring');
$radioButton_useDefault->signal_connect('toggled' => sub {
if ($radioButton_useDefault->get_active()) {
$self->ivUndef('bgColourChoice');
}
});
push (@buttonList, $radioButton_useDefault);
foreach my $rgb ($self->worldModelObj->preferBGColourList) {
my ($text, $colour, $frameColour);
$text = 'Use colour ' . uc($rgb);
# Convert RGB colours to Gdk RGBA
$colour = $rgb;
$colour =~ s/^#//;
$colour = ((hex $colour) * 256) + 255;
$frameColour = ((hex '000000') * 256) + 255;
# Create a pixbuf, with its own sub-region. Use $colour to fill the sub-region, leaving
# the renaming area of the pixbuf as a black frame
my $pixbuf = Gtk3::Gdk::Pixbuf->new(
'GDK_COLORSPACE_RGB',
FALSE,
# Same values as ->get_bits_per_sample, ->get_width, ->get_height as a
# Gtk3::Gdk::Pixbuf loaded from one of the icon files in ../share/icons/map
8,
20,
20,
);
$pixbuf->fill($frameColour);
# Create the sub-region, drawn in $colour
my $subPixbuf = $pixbuf->new_subpixbuf(1, 1, 18, 18);
$subPixbuf->fill($colour);
my $radioButton = Gtk3::RadioToolButton->new_from_widget($radioButton_useDefault);
if (defined $self->bgColourChoice && $self->bgColourChoice eq $rgb) {
$radioButton->set_active(TRUE);
}
$radioButton->set_icon_widget(
Gtk3::Image->new_from_pixbuf($pixbuf),
);
$radioButton->set_label($text);
$radioButton->set_tooltip_text($text);
$radioButton->signal_connect('toggled' => sub {
if ($radioButton->get_active()) {
$self->ivPoke('bgColourChoice', $rgb);
}
});
push (@buttonList, $radioButton);
}
return @buttonList;
}
sub drawTrackingButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my @buttonList;
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawTrackingButtonSet', @_);
}
# Toolbutton for 'centre map on current room'
my $toolButton_centreCurrentRoom = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_centre_current.png'),
'Centre map on current room',
);
$toolButton_centreCurrentRoom->set_tooltip_text('Centre map on current room');
$toolButton_centreCurrentRoom->signal_connect('clicked' => sub {
$self->centreMapOverRoom($self->mapObj->currentRoom);
});
push (@buttonList, $toolButton_centreCurrentRoom);
# (Requires $self->currentRegionmap & $self->mapObj->currentRoom)
$self->ivAdd(
'menuToolItemHash',
'icon_centre_map_current_room',
$toolButton_centreCurrentRoom,
);
# Toolbutton for 'centre map on selected room'
my $toolButton_centreSelectedRoom = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_centre_selected.png'),
'Centre map on selected room',
);
$toolButton_centreSelectedRoom->set_tooltip_text('Centre map on selected room');
$toolButton_centreSelectedRoom->signal_connect('clicked' => sub {
$self->centreMapOverRoom($self->selectedRoom);
});
push (@buttonList, $toolButton_centreSelectedRoom);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd(
'menuToolItemHash',
'icon_centre_map_selected_room',
$toolButton_centreSelectedRoom,
);
# Toolbutton for 'centre map on last known room'
my $toolButton_centreLastKnownRoom = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_centre_last.png'),
'Centre map on last known room',
);
$toolButton_centreLastKnownRoom->set_tooltip_text('Centre map on last known room');
$toolButton_centreLastKnownRoom->signal_connect('clicked' => sub {
$self->centreMapOverRoom($self->mapObj->lastKnownRoom);
});
push (@buttonList, $toolButton_centreLastKnownRoom);
# (Requires $self->currentRegionmap & $self->mapObj->lastknownRoom)
$self->ivAdd(
'menuToolItemHash',
'icon_centre_map_last_known_room',
$toolButton_centreLastKnownRoom,
);
# Toolbutton for 'centre map on middle of grid'
my $toolButton_centreMiddleGrid = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_centre_middle.png'),
'Centre map on middle of grid',
);
$toolButton_centreMiddleGrid->set_tooltip_text('Centre map on middle of grid');
$toolButton_centreMiddleGrid->signal_connect('clicked' => sub {
$self->setMapPosn(0.5, 0.5);
});
push (@buttonList, $toolButton_centreMiddleGrid);
# (Requires $self->currentRegionmap)
$self->ivAdd(
'menuToolItemHash',
'icon_centre_map_middle_grid',
$toolButton_centreMiddleGrid,
);
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
# Toggle button for 'track current room'
my $toggleButton_trackCurrentRoom = Gtk3::ToggleToolButton->new();
$toggleButton_trackCurrentRoom->set_active($self->worldModelObj->trackPosnFlag);
$toggleButton_trackCurrentRoom->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_track_room.png'),
);
$toggleButton_trackCurrentRoom->set_label('Track current room');
$toggleButton_trackCurrentRoom->set_tooltip_text('Track current room');
$toggleButton_trackCurrentRoom->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'trackPosnFlag',
$toggleButton_trackCurrentRoom->get_active(),
FALSE, # Don't call $self->redrawRegions
'track_current_room',
'icon_track_current_room',
);
}
});
push (@buttonList, $toggleButton_trackCurrentRoom);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_track_current_room', $toggleButton_trackCurrentRoom);
# Radio button for 'always track position'
my $radioButton_trackAlways = Gtk3::RadioToolButton->new(undef);
if (
$self->worldModelObj->trackingSensitivity != 0.33
&& $self->worldModelObj->trackingSensitivity != 0.66
&& $self->worldModelObj->trackingSensitivity != 1
) {
# Only the sensitivity values 0, 0.33, 0.66 and 1 are curently allowed; act as
# though the IV was set to 0
$radioButton_trackAlways->set_active(TRUE);
}
$radioButton_trackAlways->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_track_always.png'),
);
$radioButton_trackAlways->set_label('Always track position');
$radioButton_trackAlways->set_tooltip_text('Always track position');
$radioButton_trackAlways->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton_trackAlways->get_active()) {
$self->worldModelObj->setTrackingSensitivity(0);
}
});
push (@buttonList, $radioButton_trackAlways);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_track_always', $radioButton_trackAlways);
# Radio button for 'track position near centre'
my $radioButton_trackNearCentre = Gtk3::RadioToolButton->new_from_widget(
$radioButton_trackAlways,
);
if ($self->worldModelObj->trackingSensitivity == 0.33) {
$radioButton_trackNearCentre->set_active(TRUE);
}
$radioButton_trackNearCentre->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_track_centre.png'),
);
$radioButton_trackNearCentre->set_label('Track position near centre');
$radioButton_trackNearCentre->set_tooltip_text('Track position near centre');
$radioButton_trackNearCentre->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton_trackNearCentre->get_active()) {
$self->worldModelObj->setTrackingSensitivity(0.33);
}
});
push (@buttonList, $radioButton_trackNearCentre);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_track_near_centre', $radioButton_trackNearCentre);
# Radio button for 'track near edge'
my $radioButton_trackNearEdge = Gtk3::RadioToolButton->new_from_widget(
$radioButton_trackNearCentre,
);
if ($self->worldModelObj->trackingSensitivity == 0.66) {
$radioButton_trackNearEdge->set_active(TRUE);
}
$radioButton_trackNearEdge->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_track_edge.png'),
);
$radioButton_trackNearEdge->set_label('Track position near edge');
$radioButton_trackNearEdge->set_tooltip_text('Track position near edge');
$radioButton_trackNearEdge->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton_trackNearEdge->get_active()) {
$self->worldModelObj->setTrackingSensitivity(0.66);
}
});
push (@buttonList, $radioButton_trackNearEdge);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_track_near_edge', $radioButton_trackNearEdge);
# Radio button for 'track if not visible'
my $radioButton_trackNotVisible = Gtk3::RadioToolButton->new_from_widget(
$radioButton_trackNearEdge,
);
if ($self->worldModelObj->trackingSensitivity == 1) {
$radioButton_trackNotVisible->set_active(TRUE);
}
$radioButton_trackNotVisible->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_track_visible.png'),
);
$radioButton_trackNotVisible->set_label('Track if not visible');
$radioButton_trackNotVisible->set_tooltip_text('Track position if not visible');
$radioButton_trackNotVisible->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton_trackNotVisible->get_active()) {
$self->worldModelObj->setTrackingSensitivity(1);
}
});
push (@buttonList, $radioButton_trackNotVisible);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_track_not_visible', $radioButton_trackNotVisible);
return @buttonList;
}
sub drawMiscButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my @buttonList;
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawMiscButtonSet', @_);
}
# Toolbutton for 'increase visits and set current'
my $toolButton_incVisitsCurrent = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file(
$axmud::SHARE_DIR . '/icons/map/icon_inc_visits_current.png',
),
'Increase visits and set current',
);
$toolButton_incVisitsCurrent->set_tooltip_text('Increase visits and set current');
$toolButton_incVisitsCurrent->signal_connect('clicked' => sub {
$self->updateVisitsCallback('increase');
$self->mapObj->setCurrentRoom($self->selectedRoom);
});
push (@buttonList, $toolButton_incVisitsCurrent);
# (Requires $self->currentRegionmap & $self->selectedRoom)
$self->ivAdd('menuToolItemHash', 'icon_inc_visits_current', $toolButton_incVisitsCurrent);
# Toolbutton for 'increase visits by one'
my $toolButton_incVisits = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_inc_visits.png'),
'Increase visits by one',
);
$toolButton_incVisits->set_tooltip_text('Increase visits by one');
$toolButton_incVisits->signal_connect('clicked' => sub {
$self->updateVisitsCallback('increase');
});
push (@buttonList, $toolButton_incVisits);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'icon_inc_visits', $toolButton_incVisits);
# Toolbutton for 'decrease visits by one'
my $toolButton_decVisits = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_dec_visits.png'),
'Decrease visits by one',
);
$toolButton_decVisits->set_tooltip_text('Decrease visits by one');
$toolButton_decVisits->signal_connect('clicked' => sub {
$self->updateVisitsCallback('decrease');
});
push (@buttonList, $toolButton_decVisits);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'icon_dec_visits', $toolButton_decVisits);
# Toolbutton for 'set visits manually'
my $toolButton_setVisits = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_set_visits.png'),
'Set visits manually',
);
$toolButton_setVisits->set_tooltip_text('Set visits manually');
$toolButton_setVisits->signal_connect('clicked' => sub {
$self->updateVisitsCallback('manual');
});
push (@buttonList, $toolButton_setVisits);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'icon_set_visits', $toolButton_setVisits);
# Toolbutton for 'reset visits'
my $toolButton_resetVisits = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_reset_visits.png'),
'Reset visits to zero',
);
$toolButton_resetVisits->set_tooltip_text('Reset visits to zero');
$toolButton_resetVisits->signal_connect('clicked' => sub {
$self->updateVisitsCallback('reset');
});
push (@buttonList, $toolButton_resetVisits);
# (Requires $self->currentRegionmap & either $self->selectedRoom or
# $self->selectedRoomHash)
$self->ivAdd('menuToolItemHash', 'icon_reset_visits', $toolButton_resetVisits);
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
# Toggle button for 'graffiti mode'
my $toggleButton_graffitMode = Gtk3::ToggleToolButton->new();
$toggleButton_graffitMode->set_active($self->graffitiModeFlag);
$toggleButton_graffitMode->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_graffiti_mode.png'),
);
$toggleButton_graffitMode->set_label('Graffiti mode');
$toggleButton_graffitMode->set_tooltip_text('Graffiti mode');
$toggleButton_graffitMode->signal_connect('toggled' => sub {
if ($toggleButton_graffitMode->get_active()) {
$self->ivPoke('graffitiModeFlag', TRUE);
} else {
$self->ivPoke('graffitiModeFlag', FALSE);
}
# Set the equivalent menu item
if ($self->ivExists('menuToolItemHash', 'graffiti_mode')) {
my $menuItem = $self->ivShow('menuToolItemHash', 'graffiti_mode');
$menuItem->set_active($self->graffitiModeFlag);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
});
push (@buttonList, $toggleButton_graffitMode);
# (Requires $self->currentRegionmap)
$self->ivAdd('menuToolItemHash', 'icon_graffiti_mode', $toggleButton_graffitMode);
# Toolbutton for 'toggle graffiti'
my $toolButton_toggleGraffiti = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_toggle_graffiti.png'),
'Toggle graffiti',
);
$toolButton_toggleGraffiti->set_tooltip_text('Toggle graffiti in selected rooms');
$toolButton_toggleGraffiti->signal_connect('clicked' => sub {
$self->toggleGraffitiCallback();
});
push (@buttonList, $toolButton_toggleGraffiti);
# (Requires $self->currentRegionmap, $self->graffitiModeFlag and one or more selected rooms
$self->ivAdd('menuToolItemHash', 'icon_toggle_graffiti', $toolButton_toggleGraffiti);
# Separator
my $separator2 = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator2);
# Toolbutton for 'edit world model'
my $toolButton_editWorldModel = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_edit_model.png'),
'Edit world model preferences',
);
$toolButton_editWorldModel->set_tooltip_text('Edit world model');
$toolButton_editWorldModel->signal_connect('clicked' => sub {
# Open an 'edit' window for the world model
$self->createFreeWin(
'Games::Axmud::EditWin::WorldModel',
$self,
$self->session,
'Edit world model',
$self->session->worldModelObj,
FALSE, # Not temporary
);
});
push (@buttonList, $toolButton_editWorldModel);
# Toolbutton for 'search world model'
my $toolButton_searchWorldModel = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_search_model.png'),
'Search world model',
);
$toolButton_searchWorldModel->set_tooltip_text('Search world model');
$toolButton_searchWorldModel->signal_connect('clicked' => sub {
# Open a 'pref' window to conduct the search
$self->createFreeWin(
'Games::Axmud::PrefWin::Search',
$self,
$self->session,
'World model search',
);
});
push (@buttonList, $toolButton_searchWorldModel);
# Toolbutton for 'add words'
my $toolButton_addQuickWords = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_add_word.png'),
'Add dictionary words',
);
$toolButton_addQuickWords->set_tooltip_text('Add dictionary words');
$toolButton_addQuickWords->signal_connect('clicked' => sub {
$self->createFreeWin(
'Games::Axmud::OtherWin::QuickWord',
$self,
$self->session,
'Quick word adder',
);
});
push (@buttonList, $toolButton_addQuickWords);
# Toolbutton for 'edit dictionary'
my $toolButton_editDictionary = Gtk3::ToolButton->new(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_edit_dict.png'),
'Edit current dictionary',
);
$toolButton_editDictionary->set_tooltip_text('Edit current dictionary');
$toolButton_editDictionary->signal_connect('clicked' => sub {
# Open an 'edit' window for the current dictionary
$self->createFreeWin(
'Games::Axmud::EditWin::Dict',
$self,
$self->session,
'Edit \'' . $self->session->currentDict->name . '\' dictionary',
$self->session->currentDict,
FALSE, # Not temporary
);
});
push (@buttonList, $toolButton_editDictionary);
return @buttonList;
}
sub drawFlagsButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my @buttonList;
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawFlagsButtonSet', @_);
}
# Toggle button for 'release all filters'
my $radioButton_releaseAllFilters = Gtk3::ToggleToolButton->new();
$radioButton_releaseAllFilters->set_active($self->worldModelObj->allRoomFiltersFlag);
$radioButton_releaseAllFilters->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/icon_all_filters.png'),
);
$radioButton_releaseAllFilters->set_label('Release all filters');
$radioButton_releaseAllFilters->set_tooltip_text('Release all filters');
$radioButton_releaseAllFilters->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFlag(
'allRoomFiltersFlag',
$radioButton_releaseAllFilters->get_active(),
TRUE, # Do call $self->redrawRegions
'release_all_filters',
'icon_release_all_filters',
);
}
});
push (@buttonList, $radioButton_releaseAllFilters);
# (Never desensitised)
$self->ivAdd(
'menuToolItemHash',
'icon_release_all_filters',
$radioButton_releaseAllFilters,
);
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
# Filter icons
foreach my $filter ($axmud::CLIENT->constRoomFilterList) {
# Filter button
my $toolButton_filter = Gtk3::ToggleToolButton->new();
$toolButton_filter->set_active(
$self->worldModelObj->ivShow('roomFilterApplyHash', $filter),
);
$toolButton_filter->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag) {
$self->worldModelObj->toggleFilter(
$filter,
$toolButton_filter->get_active(),
);
}
});
# If it's one of the standard filters, we can use one of the existing icons;
# otherwise, use a spare icon
my $iconFile = $axmud::SHARE_DIR . '/icons/map/icon_' . $filter . '.png';
if (! -e $iconFile) {
$iconFile = $axmud::SHARE_DIR . '/icons/map/icon_spare_filter.png'
}
$toolButton_filter->set_icon_widget(
Gtk3::Image->new_from_file($iconFile)
);
$toolButton_filter->set_label('Toggle ' . $filter . ' filter');
$toolButton_filter->set_tooltip_text('Toggle ' . $filter . ' filter');
push (@buttonList, $toolButton_filter);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_' . $filter . '_filter', $toolButton_filter);
}
return @buttonList;
}
sub drawInteriorsButtonSet {
# Called by $self->chooseButtonSet, which in turn was called by $self->drawToolbar or
# ->switchToolbarButtons
# Draws buttons for this button set, and adds them to the toolbar
#
# Expected arguments
# $toolbar - The toolbar widget on which the buttons are drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $toolbar, $check) = @_;
# Local variables
my (
$lastButton,
@initList, @interiorList, @buttonList,
%interiorHash, %iconHash,
);
# Check for improper arguments
if (! defined $toolbar || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawInteriorsButtonSet', @_);
}
@initList = (
'none',
'Don\'t draw interior counts',
'icon_no_counts.png',
'shadow_count',
'Draw shadow/unallocated exits',
'icon_draw_shadow.png',
'region_count',
'Draw region/super-region exits',
'icon_draw_super.png',
'checked_count',
'Draw checked/checkable directions',
'icon_draw_checked.png',
'room_content',
'Draw room contents',
'icon_draw_contents.png',
'hidden_count',
'Draw hidden contents',
'icon_draw_hidden.png',
'temp_count',
'Draw temporary contents',
'icon_draw_temp.png',
'word_count',
'Draw recognised words',
'icon_draw_words.png',
'room_tag',
'Draw room tag',
'icon_draw_room_tag.png',
'room_flag',
'Draw room flag text',
'icon_draw_room_flag.png',
'visit_count',
'Draw character visits',
'icon_draw_visits.png',
'compare_count',
'Draw matching rooms',
'icon_draw_compare.png',
'profile_count',
'Draw exclusive profiles',
'icon_draw_exclusive.png',
'title_descrip',
'Draw titles/descriptions',
'icon_draw_descrips.png',
'exit_pattern',
'Draw exit patterns',
'icon_draw_patterns.png',
'source_code',
'Draw room source code',
'icon_draw_code.png',
'vnum',
'Draw world\'s room _vnum',
'icon_draw_vnum.png',
'grid_posn',
'Draw grid position',
'icon_draw_grid_posn.png',
);
do {
my ($mode, $descrip, $icon);
$mode = shift @initList;
$descrip = shift @initList;
$icon = shift @initList;
push (@interiorList, $mode);
$interiorHash{$mode} = $descrip;
$iconHash{$mode} = $icon;
} until (! @initList);
for (my $count = 0; $count < (scalar @interiorList); $count++) {
my ($icon, $mode);
$mode = $interiorList[$count];
# (For $count = 0, $buttonGroup is 'undef')
my $radioButton;
if ($mode eq 'none') {
$radioButton = Gtk3::RadioToolButton->new(undef);
} else {
$radioButton = Gtk3::RadioToolButton->new_from_widget($lastButton);
}
if ($self->worldModelObj->roomInteriorMode eq $mode) {
$radioButton->set_active(TRUE);
}
$radioButton->set_icon_widget(
Gtk3::Image->new_from_file($axmud::SHARE_DIR . '/icons/map/' . $iconHash{$mode}),
);
$radioButton->set_label($interiorHash{$mode});
$radioButton->set_tooltip_text($interiorHash{$mode});
$radioButton->signal_connect('toggled' => sub {
if (! $self->ignoreMenuUpdateFlag && $radioButton->get_active()) {
$self->worldModelObj->switchRoomInteriorMode($mode);
}
});
push (@buttonList, $radioButton);
# (Never desensitised)
$self->ivAdd('menuToolItemHash', 'icon_interior_mode_' . $mode, $radioButton);
$lastButton = $radioButton;
# (Add a separator after the first toolbar button)
if ($mode eq 'none') {
# Separator
my $separator = Gtk3::SeparatorToolItem->new();
push (@buttonList, $separator);
}
}
return @buttonList;
}
sub addRoomFlagButton {
# Called by a ->signal_connect in $self->drawPaintingButtonSet whenever the user clicks the
# 'add room flag' button in the 'painting' button set
# Creates a popup menu containing all room flags, then implements the user's choice
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my %checkHash;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addRoomFlagButton', @_);
}
# Compile a hash of existing preferred room flags (we don't want the user to add the same
# room flag twice)
foreach my $roomFlag ($self->worldModelObj->preferRoomFlagList) {
$checkHash{$roomFlag} = undef;
}
# Set up the popup menu
my $popupMenu = Gtk3::Menu->new();
if (! $popupMenu) {
return undef;
}
# Add a title menu item, which does nothing
my $title_item = Gtk3::MenuItem->new('Add preferred room flag:');
$title_item->signal_connect('activate' => sub {
return undef;
});
$title_item->set_sensitive(FALSE);
$popupMenu->append($title_item);
$popupMenu->append(Gtk3::SeparatorMenuItem->new()); # Separator
# Fill the popup menu with room flags
foreach my $filter ($axmud::CLIENT->constRoomFilterList) {
# A sub-sub menu for $filter
my $subSubMenu_filter = Gtk3::Menu->new();
my @nameList = $self->worldModelObj->getRoomFlagsInFilter($filter);
foreach my $name (@nameList) {
my $obj = $self->worldModelObj->ivShow('roomFlagHash', $name);
if ($obj) {
my $menuItem = Gtk3::MenuItem->new($obj->descrip);
$menuItem->signal_connect('activate' => sub {
# Add the room flag to the world model's list of preferred room flags...
$self->worldModelObj->add_preferRoomFlag($name);
# ...then redraw the window component containing the toolbar(s), toggling
# the button for the new room flag
$self->redrawWidgets('toolbar');
});
$subSubMenu_filter->append($menuItem);
}
}
if (! @nameList) {
my $menuItem = Gtk3::MenuItem->new('(No flags in this filter)');
$menuItem->set_sensitive(FALSE);
$subSubMenu_filter->append($menuItem);
}
my $menuItem = Gtk3::MenuItem->new(ucfirst($filter));
$menuItem->set_submenu($subSubMenu_filter);
$popupMenu->append($menuItem);
}
# Also add a 'Cancel' menu item, which does nothing
$popupMenu->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $cancel_item = Gtk3::MenuItem->new('Cancel');
$cancel_item->signal_connect('activate' => sub {
return undef;
});
$popupMenu->append($cancel_item);
# Display the popup menu
$popupMenu->popup(
undef, undef, undef, undef,
1, # Left mouse button
Gtk3::get_current_event_time(),
);
$popupMenu->show_all();
# Operation complete. Now wait for the user's response
return 1;
}
sub removeRoomFlagButton {
# Called by a ->signal_connect in $self->drawPaintingButtonSet whenever the user clicks the
# 'remove room flag' button in the 'painting' button set
# Removes the specified room flag from the toolbar and updates IVs
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->removeRoomFlagButton', @_);
}
# Set up the popup menu
my $popupMenu = Gtk3::Menu->new();
if (! $popupMenu) {
return undef;
}
# Add a title menu item, which does nothing
my $title_item = Gtk3::MenuItem->new('Remove preferred room flag:');
$title_item->signal_connect('activate' => sub {
return undef;
});
$title_item->set_sensitive(FALSE);
$popupMenu->append($title_item);
$popupMenu->append(Gtk3::SeparatorMenuItem->new()); # Separator
# Fill the popup menu with room flags
foreach my $roomFlag ($self->worldModelObj->preferRoomFlagList) {
my $menu_item = Gtk3::MenuItem->new($roomFlag);
$menu_item->signal_connect('activate' => sub {
# Remove the room flag from the world model's list of preferred room flags...
$self->worldModelObj->del_preferRoomFlag($roomFlag);
# ...and from the painter object iself...
$self->worldModelObj->painterObj->ivDelete('roomFlagHash', $roomFlag);
# ...then redraw the window component containing the toolbar(s)
$self->redrawWidgets('toolbar');
});
$popupMenu->append($menu_item);
}
# Add a 'remove all' menu item
$popupMenu->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $remove_all_item = Gtk3::MenuItem->new('Remove all');
$remove_all_item->signal_connect('activate' => sub {
my ($total, $choice);
$total = scalar $self->worldModelObj->preferRoomFlagList;
# If there's more than one colour, prompt the user for confirmation
if ($total > 1) {
$choice = $self->showMsgDialogue(
'Remove all room flag buttons',
'question',
'Are you sure you want to remove all ' . $total . ' room flag buttons?',
'yes-no',
);
} else {
$choice = 'yes';
}
if (defined $choice && $choice eq 'yes') {
# Reset the world model's list of preferred room flags
$self->worldModelObj->reset_preferRoomFlagList();
# Update the painter object (which might contain room flags not added with these
# tools)
foreach my $roomFlag ($self->worldModelObj->preferRoomFlagList) {
$self->worldModelObj->ivDelete('roomFlagHash', $roomFlag);
}
# Then redraw the window component containing the toolbar(s)
$self->redrawWidgets('toolbar');
}
});
$popupMenu->append($remove_all_item);
# Also add a 'Cancel' menu item, which does nothing
my $cancel_item = Gtk3::MenuItem->new('Cancel');
$cancel_item->signal_connect('activate' => sub {
return undef;
});
$popupMenu->append($cancel_item);
# Display the popup menu
$popupMenu->popup(
undef, undef, undef, undef,
1, # Left mouse button
Gtk3::get_current_event_time(),
);
$popupMenu->show_all();
# Operation complete. Now wait for the user's response
return 1;
}
sub addBGColourButton {
# Called by a ->signal_connect in $self->drawBackgroundButtonSet whenever the user clicks
# the 'add background colour' button in the 'background' button set
# Prompts the user for a new RGB colour tag, then implements the user's choice
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $colour;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addBGColourButton', @_);
}
$colour = $self->showColourSelectionDialogue('Add preferred background colour');
if (defined $colour) {
# Add the room flag to the world model's list of preferred background colours...
$self->worldModelObj->add_preferBGColour($colour);
# ...then redraw the window component containing the toolbar(s), selecting the new
# colour
$self->ivPoke('bgColourChoice', $colour);
$self->redrawWidgets('toolbar');
}
return 1;
}
sub removeBGColourButton {
# Called by a ->signal_connect in $self->drawBackgroundButtonSet whenever the user clicks
# the 'remove background colour' button in the 'background' button set
# Removes the specified colour from the toolbar and updates IVs
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->removeBGColourButton', @_);
}
# Set up the popup menu
my $popupMenu = Gtk3::Menu->new();
if (! $popupMenu) {
return undef;
}
# Add a title menu item, which does nothing
my $title_item = Gtk3::MenuItem->new('Remove preferred background colour:');
$title_item->signal_connect('activate' => sub {
return undef;
});
$title_item->set_sensitive(FALSE);
$popupMenu->append($title_item);
$popupMenu->append(Gtk3::SeparatorMenuItem->new()); # Separator
# Fill the popup menu with colours
foreach my $colour ($self->worldModelObj->preferBGColourList) {
my $menu_item = Gtk3::MenuItem->new($colour);
$menu_item->signal_connect('activate' => sub {
# Remove the colour from the world model's list of preferred background colours...
$self->worldModelObj->del_preferBGColour($colour);
# ...then redraw the window component containing the toolbar(s)
$self->redrawWidgets('toolbar');
});
$popupMenu->append($menu_item);
}
# Add a 'remove all' menu item
$popupMenu->append(Gtk3::SeparatorMenuItem->new()); # Separator
my $remove_all_item = Gtk3::MenuItem->new('Remove all');
$remove_all_item->signal_connect('activate' => sub {
my ($total, $choice);
$total = scalar $self->worldModelObj->preferBGColourList;
# If there's more than one colour, prompt the user for confirmation
if ($total > 1) {
$choice = $self->showMsgDialogue(
'Remove all colour buttons',
'question',
'Are you sure you want to remove all ' . $total . ' colour buttons?',
'yes-no',
);
} else {
$choice = 'yes';
}
if (defined $choice && $choice eq 'yes') {
# Reset the world model's list of preferred background colour...
$self->worldModelObj->reset_preferBGColourList();
# ...then redraw the window component containing the toolbar(s)
$self->redrawWidgets('toolbar');
}
});
$popupMenu->append($remove_all_item);
# Also add a 'Cancel' menu item, which does nothing
my $cancel_item = Gtk3::MenuItem->new('Cancel');
$cancel_item->signal_connect('activate' => sub {
return undef;
});
$popupMenu->append($cancel_item);
# Display the popup menu
$popupMenu->popup(
undef, undef, undef, undef,
1, # Left mouse button
Gtk3::get_current_event_time(),
);
$popupMenu->show_all();
# Operation complete. Now wait for the user's response
return 1;
}
# Treeview widget methods
sub enableTreeView {
# Called by $self->drawWidgets
# Sets up the Automapper window's treeview widget
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::ScrolledWindow containing the Gtk3::TreeView created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableTreeView', @_);
}
# Create the treeview
my $objectModel = Gtk3::TreeStore->new( ['Glib::String'] );
my $treeView = Gtk3::TreeView->new($objectModel);
if (! $objectModel || ! $treeView) {
return undef;
}
# No interactive searches required
$treeView->set_enable_search(FALSE);
# Append a single column to the treeview
$treeView->append_column(
Gtk3::TreeViewColumn->new_with_attributes(
'Regions',
Gtk3::CellRendererText->new,
markup => 0,
)
);
# Make the treeview scrollable
my $treeViewScroller = Gtk3::ScrolledWindow->new;
$treeViewScroller->add($treeView);
$treeViewScroller->set_policy(qw/automatic automatic/);
# Make the branches of the list tree clickable, so the rows can be expanded and collapsed
$treeView->signal_connect('row_activated' => sub {
my ($treeView, $path, $column) = @_;
$self->treeViewRowActivatedCallback();
});
$treeView->get_selection->set_mode('browse');
$treeView->get_selection->signal_connect('changed' => sub {
my ($selection) = @_;
$self->treeViewRowChangedCallback($selection);
});
# Respond when the user expands/collapses rows
$treeView->signal_connect('row_expanded' => sub {
my ($widget, $iter, $path) = @_;
$self->treeViewRowExpandedCallback($iter);
});
$treeView->signal_connect('row_collapsed' => sub {
my ($widget, $iter, $path) = @_;
$self->treeViewRowCollapsedCallback($iter);
});
# Store the widgets
$self->ivPoke('treeView', $treeView);
$self->ivPoke('treeViewScroller', $treeViewScroller);
$self->ivPoke('treeViewModel', $objectModel);
# Fill the tree with a list of regions
$self->resetTreeView();
# Setup complete
return $treeViewScroller;
}
sub resetTreeView {
# Called by $self->winEnable and various other functions
# Fills the object tree on the left of the Automapper window, listing all the regions in
# the current world model
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $expandRegion - If specified, this function makes sure the object tree is expanded to
# make the specified region visible. $expandRegion is the region's
# name
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $expandRegion, $check) = @_;
# Local variables
my (
$model, $count, $firstRegionObj,
@initList, @otherList, @tempList, @combList, @childList,
%pointerHash, %regionHash, %markupHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetTreeView', @_);
}
# Fill a model of the tree, not the tree itself
$model = $self->treeView->get_model();
$model->clear();
# Import the list of regions
@initList = $self->worldModelObj->ivValues('regionModelHash');
# Remove a region which is supposed to be at the top of the list, and any temporary regions
# which should be at the bottom of it
foreach my $regionObj (@initList) {
if (
defined $self->worldModelObj->firstRegion
&& $self->worldModelObj->firstRegion eq $regionObj->name
) {
$firstRegionObj = $regionObj;
$markupHash{$regionObj} = $regionObj->name;
} elsif ($regionObj->tempRegionFlag) {
push (@tempList, $regionObj);
$markupHash{$regionObj} = '<i>' . $regionObj->name . '</i>';
} else {
push (@otherList, $regionObj);
$markupHash{$regionObj} = $regionObj->name;
}
if ($regionObj->finishedFlag) {
$markupHash{$regionObj} = '<u>' . $markupHash{$regionObj} . '</u>';
}
}
# Sort the regions in their lists
# NB If the flag is set to TRUE, the regions are shown in reverse alphabetical order
if ($self->worldModelObj->reverseRegionListFlag) {
# Reverse order
@otherList = sort {lc($b->name) cmp lc($a->name)} (@otherList);
@tempList = sort {lc($b->name) cmp lc($a->name)} (@tempList);
} else {
# Normal order
@otherList = sort {lc($a->name) cmp lc($b->name)} (@otherList);
@tempList = sort {lc($a->name) cmp lc($b->name)} (@tempList);
}
# Restore the combined, ordered list
@combList = (@otherList, @tempList);
if ($firstRegionObj) {
unshift (@combList, $firstRegionObj);
}
# Import the hash which records the rows that have been expanded (and not then collapsed),
# before emptying it, ready for re-filling
%regionHash = $self->treeViewRegionHash;
$self->ivEmpty('treeViewRegionHash');
# We need to add parent regions to the treeview before we add any child regions. Go through
# the list, removing regions that have no parent, and adding them to the treeview
foreach my $regionObj (@combList) {
my $pointer;
# Each row containing a region is, by default, not expanded
$self->ivAdd('treeViewRegionHash', $regionObj->name, 0);
if ($regionObj->parent) {
# This is a child region; add it to the treeview later
push (@childList, $regionObj);
} else {
# Add this region to the treeview now
$pointer = $model->append(undef);
$model->set( $pointer, [0], [$markupHash{$regionObj}] );
# Store $pointer in a hash, so that if this region has any child regions, they can
# be added directly below in the treeview
$pointerHash{$regionObj->name} = $pointer;
}
}
# Now, if there are any child regions, add them to the treeview just below their parent
# regions. Do this operation recursively until there are no regions left
do {
my (
@grandChildList,
%newPointerHash,
);
$count = 0;
foreach my $regionObj (@childList) {
my ($parentObj, $pointer, $childPointer);
$parentObj = $self->worldModelObj->ivShow('modelHash', $regionObj->parent);
if (! exists $pointerHash{$parentObj->name}) {
# This region's parent hasn't been added to the treeview yet; add it later
push (@grandChildList, $regionObj);
} else {
$count++;
# Add this region to the treeview, just below its parent
$pointer = $pointerHash{$parentObj->name};
$childPointer = $model->append($pointer);
$model->set( $childPointer, [0], [$markupHash{$regionObj}] );
# Store $childPointer in a hash, so that if this region has any child regions,
# they can be added directly below in the treeview
# (Don't add it to %pointerHash until the end of this loop iteration, otherwise
# some regions won't appear in alphabetical order in the treeview)
$newPointerHash{$regionObj->name} = $childPointer;
}
}
# All regions that were added in this loop must be moved from %newPointerHash to
# %pointerHash
foreach my $key (keys %newPointerHash) {
$pointerHash{$key} = $newPointerHash{$key};
}
%newPointerHash = ();
# If there is anything in @grandChildList, they must be processed on the next iteration
@childList = @grandChildList;
} until (! @childList || ! $count);
# If @childList still contains any regions, their parent(s) are either not regions (this
# should never happen), or the regions don't exist any more (ditto)
# Display them at the end of the treeview
foreach my $regionObj (@childList) {
my $pointer;
# Add this region to the treeview now
$pointer = $model->append(undef);
$model->set( $pointer, [0], [$regionObj->name] );
}
# Now expand any of the rows that were expanded before the call to this function
if (%regionHash) {
foreach my $regionName (keys %regionHash) {
my $path;
if (
$regionHash{$regionName}
&& $self->ivExists('treeViewRegionHash', $regionName)
) {
# This row must be expanded
$path = $model->get_path($pointerHash{$regionName});
$self->treeView->expand_row($path, FALSE);
# Mark it as expanded
$self->ivAdd('treeViewRegionHash', $regionName, TRUE);
}
}
}
# Store the hash of pointers ($self->treeViewSelectRow needs them)
$self->ivPoke('treeViewPointerHash', %pointerHash);
# If a specific region was specified as $expandRegion, it must be visible (we must expand
# all its parents, if not already expanded)
if ($expandRegion) {
$self->expandTreeView($model, $expandRegion);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# Operation complete
return 1;
}
sub expandTreeView {
# Called by $self->resetTreeView and by this function, recursively
# Expands rows in the tree model, to make sure that a certain region is visible.
#
# Expected arguments
# $model - The treeview model (a Gtk3::TreeModel object)
# $expandRegion - The name of a region that should be visible. This function expands
# the row belonging to $expandRegion's parent (if any), then calls
# this function recursively, to expand the row for the parent's
# parent (if any)
#
# Return values
# 'undef' on improper arguments or if no further expansions are required
# 1 otherwise
my ($self, $model, $expandRegion, $check) = @_;
# Local variables
my ($expandObj, $parentObj, $pointer, $path);
# Check for improper arguments
if (! defined $model || ! defined $expandRegion || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->expandTreeView', @_);
}
# Find the corresponding world model object
$expandObj = $self->findRegionObj($expandRegion);
if (! $expandObj || ! $expandObj->parent) {
# No further expansions required
return undef;
}
# Get the parent object's name
$parentObj = $self->worldModelObj->ivShow('modelHash', $expandObj->parent);
# Expand the parent's row (if it's not already expanded)
if (
$self->ivExists('treeViewRegionHash', $parentObj->name)
&& ! $self->ivShow('treeViewRegionHash', $parentObj->name)
) {
# This row must be expanded
$pointer = $self->ivShow('treeViewPointerHash', $parentObj->name);
$path = $model->get_path($pointer);
$self->treeView->expand_row($path, TRUE);
# Mark it as expanded
$self->ivAdd('treeViewRegionHash', $parentObj->name, TRUE);
}
# Call this function recursively, to expand the parent's parent (if it has one)
$self->expandTreeView($model, $parentObj->name);
return 1;
}
sub treeViewRowActivatedCallback {
# Treeview's 'row_activated' callback - called when the user double-clicks on one of the
# treeview's cells
# Called from an anonymous sub in $self->enableTreeView
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $regionName;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->treeViewRowActivatedCallback',
@_,
);
}
# Don't do anything if the canvas is currently invisible
if ($self->worldModelObj->showCanvasFlag) {
# Get the selected region
$regionName = $self->treeViewSelectedLine;
if ($regionName) {
if ($self->worldModelObj->ivExists('regionmapHash', $regionName)) {
# Make it the selected region, and draw it on the map
$self->setCurrentRegion($regionName);
} else {
# Remove any markup to get the actual region name
$regionName =~ s/^\<[iu]\>//;
$regionName =~ s/\<\/[iu]\>$//;
if ($self->worldModelObj->ivExists('regionmapHash', $regionName)) {
# Make it the selected region, and draw it on the map
$self->setCurrentRegion($regionName);
}
}
}
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
sub treeViewRowChangedCallback {
# Treeview's 'changed' callback - called when the user single-clicks on one of the
# treeview's cells
# Called from an anonymous sub in $self->enableTreeView
#
# Expected arguments
# $selection - A Gtk3::Selection
#
# Return values
# 'undef' on improper arguments or if the selection is not recognised
# 1 otherwise
my ($self, $selection, $check) = @_;
# Local variables
my ($model, $iter, $region);
# Check for improper arguments
if (! defined $selection || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->treeViewRowChangedCallback',
@_,
);
}
($model, $iter) = $selection->get_selected();
if (! $iter) {
return undef;
} else {
# Get the region on the selected line
$region = $model->get($iter, 0);
# Store it, so that other methods can access the region on the selected line
$self->ivPoke('treeViewSelectedLine', $region);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
}
sub treeViewRowExpandedCallback {
# Treeview's 'row_expanded' callback - called when the user expands one of the treeview's
# rows to reveal a region's child regions
# Called from an anonymous sub in $self->enableTreeView
#
# Expected arguments
# $iter - A Gtk3::TreeIter
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $iter, $check) = @_;
# Local variables
my $region;
# Check for improper arguments
if (! defined $iter || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->treeViewRowExpandedCallback',
@_,
);
}
# Get the region in the expanded row
$region = $self->treeViewModel->get($iter, 0);
# Mark the row as expanded
$self->ivAdd('treeViewRegionHash', $region, TRUE);
return 1;
}
sub treeViewRowCollapsedCallback {
# Treeview's 'row_collapsed' callback - called when the user collapses one of the treeview's
# rows to hide a region's child regions
# Called from an anonymous sub in $self->enableTreeView
#
# Expected arguments
# $iter - A Gtk3::TreeIter
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $iter, $check) = @_;
# Local variables
my $region;
# Check for improper arguments
if (! defined $iter || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->treeViewRowCollapsedCallback',
@_,
);
}
# Get the region in the collapsed row
$region = $self->treeViewModel->get($iter, 0);
# Mark the row as collapsed
$self->ivAdd('treeViewRegionHash', $region, FALSE);
return 1;
}
sub treeViewSelectRow {
# Called by $self->setCurrentRegion when the current region is set (or unset)
# Makes sure that, if there's a new current region, it is the one highlighted in the
# treeview's list
#
# Expected arguments
# $region - The name of the highlighted region (matches $self->currentRegionmap->name)
# - if not specified, there is no current region
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $region, $check) = @_;
# Local variables
my ($pointer, $path);
# Check for improper arguments
if (! defined $region || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->treeViewSelectRow', @_);
}
# Highlight the region named $region
$pointer = $self->ivShow('treeViewPointerHash', $region);
$path = $self->treeViewModel->get_path($pointer);
# If the new region has a parent, we need to expand the parent so that the new region is
# visible, once highlighted
if ($path->up()) {
$self->treeView->expand_to_path($path);
# Reset the path to the region we want to highlight
$path = $self->treeViewModel->get_path($pointer);
}
# Highlight the region
$self->treeView->set_cursor($path, undef, 0);
return 1;
}
sub treeViewUpdateRow {
# Called by $self->enableRegionsColumn when the current region's 'finished' status is set
# Updates the markup for the treeview row for this region
#
# Expected arguments
# $region - The name of the current region
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $region, $check) = @_;
# Local variables
my ($regionmapObj, $regionObj, $markup, $model, $pointer);
# Check for improper arguments
if (! defined $region || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->treeViewUpdateRow', @_);
}
# Prepare the markup
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $region);
$regionObj = $self->worldModelObj->ivShow('regionModelHash', $regionmapObj->number);
if ($regionObj->tempRegionFlag) {
$markup = '<i>' . $region . '</i>';
} elsif ($regionObj->finishedFlag) {
$markup = '<u>' . $region . '</u>';
} else {
$markup = $region;
}
# Update the markup for the region's line in the treeview
$model = $self->treeView->get_model();
$pointer = $self->ivShow('treeViewPointerHash', $region);
$model->set( $pointer, [0], [$markup] );
return 1;
}
# Canvas widget methods
sub enableCanvas {
# Called by $self->drawWidgets and ->redrawWidgets (only)
# Sets up canvas widgets
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the widget can't be created
# Otherwise returns the Gtk3::Frame containing the Gtk3::Canvas created
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableCanvas', @_);
}
# Create a frame
my $canvasFrame = Gtk3::Frame->new(undef);
$canvasFrame->set_border_width(3);
# Create a scrolled window
my $canvasScroller = Gtk3::ScrolledWindow->new();
my $canvasHAdjustment = $canvasScroller->get_hadjustment();
my $canvasVAdjustment = $canvasScroller->get_vadjustment();
$canvasScroller->set_border_width(3);
# Set the scrolling policy
$canvasScroller->set_policy('always','always');
# Add the scrolled window to the frame
$canvasFrame->add($canvasScroller);
# The only way to scroll the map to the correct position, is to store the scrolled window's
# size allocation whenever it is set
$canvasScroller->signal_connect('size-allocate' => sub {
my ($widget, $hashRef) = @_;
$self->ivPoke('canvasScrollerWidth', $$hashRef{width});
$self->ivPoke('canvasScrollerHeight', $$hashRef{height});
});
# Store the remaining widgets
$self->ivPoke('canvasFrame', $canvasFrame);
$self->ivPoke('canvasScroller', $canvasScroller);
$self->ivPoke('canvasHAdjustment', $canvasHAdjustment);
$self->ivPoke('canvasVAdjustment', $canvasVAdjustment);
# Set up tooltips
$self->enableTooltips();
# Draw the empty background map (default is white)
$self->resetMap();
# Setup complete
return $canvasFrame;
}
sub enableTooltips {
# Called by $self->enableCanvas (only)
# Sets up tooltips
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->enableTooltips', @_);
}
# Create a Gtk3::Window to act as a tooltip, being visible (or not) as appropriate
my $tooltipLabel = Gtk3::Label->new();
my $tooltipWin = Gtk3::Window->new('popup');
$tooltipWin->set_decorated(FALSE);
$tooltipWin->set_position('mouse');
$tooltipWin->set_border_width(2);
$tooltipWin->modify_fg('normal', [Gtk3::Gdk::Color::parse('black')]->[1]);
$tooltipWin->modify_bg('normal', [Gtk3::Gdk::Color::parse('yellow')]->[1]);
$tooltipWin->add($tooltipLabel);
# Update IVs
$self->ivPoke('canvasTooltipObj', undef);
$self->ivPoke('canvasTooltipObjType', undef);
$self->ivPoke('canvasTooltipFlag', FALSE);
# Setup complete
return 1;
}
sub setMapPosn {
# Can be called by anything
# Scroll the canvas to the desired position, revealing a portion of the map
#
# Expected arguments
# $xPos - Value between 0 (far left) and 1 (far right)
# $yPos - Value between 0 (far top) and 1 (far bottom)
#
# Return values
# 'undef' on improper arguments or if there is no current regionmap
# 1 otherwise
my ($self, $xPos, $yPos, $check) = @_;
# Local variables
my ($canvasWidget, $xBlocks, $yBlocks, $xPixels, $yPixels, $scrollX, $scrollY);
# Check for improper arguments
if (! defined $xPos || ! defined $yPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setMapPosn', @_);
}
# Do nothing if there is no current regionmap
if (! $self->currentRegionmap) {
return undef;
}
# Get the canvas widget to be scrolled
$canvasWidget = $self->currentParchment->ivShow(
'canvasWidgetHash',
$self->currentRegionmap->currentLevel,
);
# The code in this function, which uses GooCanvas2::Canvas->scroll_to, produces a slightly
# different value to the code in $self->getMapPosn, which uses scrollbar positions
# When moving up and down through map levels, this causes the scroll position to drift from
# its original position
# The only way to deal with this is to adjust $xPos and $yPos so that they represent the
# middle of a gridblock. In that way, the first change of level might adjust the map's
# scroll position (slightly), but subsequent changes preserve the exact same scroll
# position
$xBlocks = int(
($xPos * $self->currentRegionmap->mapWidthPixels)
/ $self->currentRegionmap->blockWidthPixels
);
$yBlocks = int(
($yPos * $self->currentRegionmap->mapHeightPixels)
/ $self->currentRegionmap->blockHeightPixels
);
$xPixels = ($xBlocks * $self->currentRegionmap->blockWidthPixels)
+ int($self->currentRegionmap->blockWidthPixels / 2) + 1;
$yPixels = ($yBlocks * $self->currentRegionmap->blockHeightPixels)
+ int ($self->currentRegionmap->blockHeightPixels / 2) + 1;
$xPos = $xPixels / $self->currentRegionmap->mapWidthPixels;
$yPos = $yPixels / $self->currentRegionmap->mapHeightPixels;
# Previously, the map's position was set by moving the scrollbars directly. Under GooCanvas2
# that no longer works, so we'll use the ->scroll_to() function instead
# Previously, a map that was smaller than the available area was positioned in the centre
# of the available area. Under GooCanvas2 that's no longer possible, so a small map is now
# positioned in the top-left corner
$scrollX = int (
($xPos * $self->currentRegionmap->mapWidthPixels)
- (($self->canvasScrollerWidth / $canvasWidget->get_scale()) / 2)
);
if ($scrollX < 0) {
$scrollX = 0;
}
$scrollY = int (
($yPos * $self->currentRegionmap->mapHeightPixels)
- (($self->canvasScrollerHeight / $canvasWidget->get_scale()) / 2)
);
if ($scrollY < 0) {
$scrollY = 0;
}
$canvasWidget->scroll_to($scrollX, $scrollY);
return 1;
}
sub getMapPosn {
# Can be called by anything
# Gets the position and size of canvas scrollbars, expressed as values between 0 and 1
#
# Expected arguments
# (none besides $self)
#
# Return arguments
# An empty list on improper arguments or if there is no current regionmap
# Otherwise, a list in the form ($xOffset, $yOffset, $xPos, $yPos, $width, $height):
# $xOffset - Position of the horizontal scrollbar. 0 - as far left as possible,
# 1 - as far right as possible
# $yOffset - Position of the vertical scrollbar. 0 - as far up as possible,
# 1 - as down right as possible
# $xPos - Position of the left end of the visible portion of the map. 0 - left
# edge is visible, 0.5 - middle of the map is visible on the left
# border, etc
# $yPos - Position of the top end of the visible portion of the map. 0 - top
# edge is visible, 0.5 - middle of the map is visible on the top
# border, etc
# $width - Width of the currently visible portion of the map. 1 - total width of
# map is visible; 0.5 - 50% of the total width of the map is visible,
# 0.1 - 10% of the total width of the map is visible (etc)
# $height - Height of the currently visible portion of the map. 1 - total height
# of map is visible; 0.5 - 50% of the total height of the map is
# visible, 0.1 - 10% of the total height of the map is visible (etc)
my ($self, $check) = @_;
# Local variables
my (
$xOffset, $yOffset, $xPos, $yPos, $width, $height,
@emptyList,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getMapPosn', @_);
return @emptyList;
}
# Do nothing if there is no current regionmap
if (! $self->currentRegionmap) {
return @emptyList;
}
# Get the position of the horizontal scrollbar (a value between 0 and 1)
if ($self->canvasHAdjustment->get_upper() == $self->canvasHAdjustment->get_page_size()) {
$xOffset = 0;
} else {
$xOffset = $self->canvasHAdjustment->get_value()
/ (
$self->canvasHAdjustment->get_upper()
- $self->canvasHAdjustment->get_page_size()
);
}
# Get the position of the vertical scrollbar (a value between 0 and 1)
if ($self->canvasVAdjustment->get_upper() == $self->canvasVAdjustment->get_page_size()) {
$yOffset = 0;
} else {
$yOffset = $self->canvasVAdjustment->get_value()
/ (
$self->canvasVAdjustment->get_upper()
- $self->canvasVAdjustment->get_page_size()
);
}
# Get the position of the left end of the visible portion of the map (a value between
# 0 and 1)
$xPos = $self->canvasHAdjustment->get_value() / $self->canvasHAdjustment->get_upper();
# Get the position of the top end of the visible portion of the map (a value between
# 0 and 1)
$yPos = $self->canvasVAdjustment->get_value() / $self->canvasVAdjustment->get_upper();
# Get the size of the horizontal scrollbar (a value between 0 and 1)
$width = $self->canvasHAdjustment->get_page_size() / $self->canvasHAdjustment->get_upper();
# Get the size of the horizontal scrollbar (a value between 0 and 1)
$height = $self->canvasVAdjustment->get_page_size() / $self->canvasVAdjustment->get_upper();
return ($xOffset, $yOffset, $xPos, $yPos, $width, $height);
}
sub getMapPosnInBlocks {
# Can be called by anything (e.g. by ->trackPosn)
# Converts the output of $self->getMapPosn (a list of six values, all in the range 0-1)
# into the position and size of the visible map, measured in gridblocks, ignoring any
# partial gridblocks along the four edges of the visible map
#
# Expected arguments
# (none besides $self)
#
# Return arguments
# An empty list on improper arguments, or if there is no current regionmap
# Otherwise, a list in the form ($xPosBlocks, $yPosBlocks, $widthBlocks, $heightBlocks):
# $xPosBlocks, $yPosBlocks
# - The grid coordinates of top-left corner of the visible portion of the map
# $widthBlocks, $heightBlocks
# - The size of the visible map, in gridblocks
my ($self, $check) = @_;
# Local variables
my (
$xOffsetRatio, $yOffsetRatio, $xPosRatio, $yPosRatio, $widthRatio, $heightRatio,
$xRawBlocks, $xPosBlocks, $xDiff, $yRawBlocks, $yPosBlocks, $yDiff, $widthBlocks,
$heightBlocks,
@emptyList,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getMapPosnInBlocks', @_);
return @emptyList;
}
# Do nothing if there is no current regionmap
if (! $self->currentRegionmap) {
return @emptyList;
}
# Get the size and position of the visible map. The return values of $self->getMapPosn are
# all values in the range 0-1
# (We don't need $xOffsetRatio or $yOffsetRatio)
($xOffsetRatio, $yOffsetRatio, $xPosRatio, $yPosRatio, $widthRatio, $heightRatio)
= $self->getMapPosn();
# Convert these values into gridblocks. The code gets values that ignore partial gridblocks
# along all four edges of the visible area
$xRawBlocks = $xPosRatio * $self->currentRegionmap->gridWidthBlocks;
$xPosBlocks = POSIX::ceil($xRawBlocks);
$xDiff = $xPosBlocks - $xRawBlocks;
$yRawBlocks = $yPosRatio * $self->currentRegionmap->gridHeightBlocks;
$yPosBlocks = POSIX::ceil($yRawBlocks);
$yDiff = $yPosBlocks - $yRawBlocks;
$widthBlocks = int(
($widthRatio * $self->currentRegionmap->gridWidthBlocks) - $xDiff,
);
$heightBlocks = int(
($heightRatio * $self->currentRegionmap->gridHeightBlocks) - $yDiff,
);
return ($xPosBlocks, $yPosBlocks, $widthBlocks, $heightBlocks);
}
sub centreMapOverRoom {
# Can be called by anything
# Centres the map over a specified room, as far as possible (if the room is near map's
# edges, the map will be centred as close as possible to the room)
# If the specified room isn't in the current region, a new current region is set
# Alternatively, instead of specifying a room, the calling function can specify a gridblock;
# the map is centred over that gridblock, even if it doesn't contain a room
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $roomObj - The room over which to centre the map. If specified, the remaining
# arguments are ignored
# $xPosBlocks, $yPosBlocks
# - A gridblock on the map, in the current region, on the current level
# (ignored if $roomObj is specified)
#
# Return values
# 'undef' on improper arguments or if no arguments are specified at all
# 1 otherwise
my ($self, $roomObj, $xPosBlocks, $yPosBlocks, $check) = @_;
# Local variables
my ($regionObj, $blockCentreXPosPixels, $blockCentreYPosPixels);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->centreMapOverRoom', @_);
}
# If a room was specified...
if ($roomObj) {
# Check that the specified room is in the current region
if ($roomObj->parent && $self->currentRegionmap) {
if ($roomObj->parent != $self->currentRegionmap->number) {
$regionObj = $self->worldModelObj->ivShow('modelHash', $roomObj->parent);
# Change the current region to the one containing the specified room
$self->setCurrentRegion($regionObj->name);
}
# Set the right level
if ($self->currentRegionmap->currentLevel != $roomObj->zPosBlocks) {
$self->setCurrentLevel($roomObj->zPosBlocks);
}
}
$xPosBlocks = $roomObj->xPosBlocks;
$yPosBlocks = $roomObj->yPosBlocks;
} elsif (! defined $xPosBlocks || ! defined $yPosBlocks) {
# Can't do anything without arguments
return undef;
}
# Convert that position into canvas coordinates, and centre the map at that position
($blockCentreXPosPixels, $blockCentreYPosPixels) = $self->getBlockCentre(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
);
$self->setMapPosn(
($blockCentreXPosPixels / $self->currentRegionmap->mapWidthPixels),
($blockCentreYPosPixels / $self->currentRegionmap->mapHeightPixels),
);
return 1;
}
sub doZoom {
# Called by $self->worldModelObj->setMagnification
# Zooms the map in or out, depending on the new value of
# $self->currentRegionmap->magnification
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if no arguments are specified at all
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
@redrawList,
%newHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doZoom', @_);
}
# Set the visible map's size. Each GooCanvas2::Canvas automatically takes care of its
# position, so that the same part of the map is visible in the window
foreach my $canvasWidget ($self->currentParchment->ivValues('canvasWidgetHash')) {
$canvasWidget->set_scale($self->currentRegionmap->magnification);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
# Menu bar/toolbar widget sensitisers
sub restrictWidgets {
# Many menu bar and toolbar items can be sensitised, or desensitised, depending on
# conditions
# This function can be called by anything, any time one of those conditions changes, so that
# every menu bar/toolbar item can be sensitised or desensitised correctly
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$regionObj,
@list, @sensitiseList, @desensitiseList, @magList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->restrictWidgets', @_);
}
# Modified v1.0.150 - anything that requires the current regionmap, also requires
# the character to be logged in (with a handful of exceptions)
# Modified v1.0.363 - we now allow zooming and a few other things from the 'View' menu
# when the character isn't logged in
# Menu items that require a current regionmap AND a logged in character
@list = (
'select', 'unselect_all',
'selected_objs',
'set_follow_mode', 'icon_set_follow_mode',
'screenshots', 'icon_visible_screenshot',
'drag_mode', 'icon_drag_mode',
'graffiti_mode', 'icon_graffiti_mode',
'edit_region',
'edit_regionmap',
'current_region',
'redraw_region',
'recalculate_paths',
'exit_tags',
'exit_options',
'empty_region',
'delete_region',
'add_room',
'add_label_at_click',
'add_label_at_block',
'room_text',
'other_room_features',
'select_label',
'report_region',
'report_visits_2',
'report_guilds_2',
'report_flags_2',
'report_flags_4',
'report_rooms_2',
'report_exits_2',
'report_checked_2',
'reset_locator', 'icon_reset_locator',
);
if ($self->currentRegionmap && $self->session->loginFlag) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap BUT NOT a logged in character
@list = (
'zoom_sub',
'level_sub',
'centre_map_middle_grid', 'icon_centre_map_middle_grid',
'centre_map_sub',
'move_up_level', 'icon_move_up_level',
'move_down_level', 'icon_move_down_level',
'this_region_scheme',
'exit_lengths', 'icon_horizontal_lengths', 'icon_vertical_lengths',
);
if ($self->currentRegionmap) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, GA::Obj::WorldModel->disableUpdateModeFlag
# set to FALSE and a session not in 'connect offline' mode
@list = (
'set_update_mode', 'icon_set_update_mode',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ! $self->worldModelObj->disableUpdateModeFlag
&& $self->session->status ne 'offline'
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap for a region that doesn't have a parent region
@list = (
'move_region_top',
);
if ($self->currentRegionmap) {
$regionObj
= $self->worldModelObj->ivShow('regionModelHash', $self->currentRegionmap->number);
}
if ($regionObj && ! $regionObj->parent) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a current room
@list = (
'centre_map_current_room', 'icon_centre_map_current_room',
'add_room_contents',
'add_hidden_object',
'add_search_result',
'unset_current_room',
'update_locator',
'repaint_current',
'execute_scripts',
'add_failed_room',
'add_involuntary_exit',
'add_repulse_exit',
'add_special_depart',
'add_unspecified_pattern',
'icon_fail_exit',
);
if ($self->currentRegionmap && $self->session->loginFlag && $self->mapObj->currentRoom) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected room
@list = (
'centre_map_selected_room', 'icon_centre_map_selected_room',
'set_current_room', 'icon_set_current_room',
'select_exit',
'increase_set_current',
'edit_room',
'set_file_path',
'add_contents_string',
'add_hidden_string',
'add_exclusive_prof',
'icon_inc_visits_current',
);
if ($self->currentRegionmap && $self->session->loginFlag && $self->selectedRoom) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and either a single selected room or a single
# selected room tag
@list = (
'set_room_tag',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->selectedRoom || $self->selectedRoomTag)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, a current room and a single selected room
# (the current room and selected room shouldn't be the same)
@list = (
'path_finding_highlight',
'path_finding_edit',
'path_finding_go',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->mapObj->currentRoom
&& $self->selectedRoom
&& $self->mapObj->currentRoom ne $self->selectedRoom
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and either a current room or a single selected
# room
@list = (
'add_to_model',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->mapObj->currentRoom || $self->selectedRoom)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected room with one or more
# checked directions
@list = (
'remove_checked', 'remove_checked_all',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedRoom
&& $self->selectedRoom->checkedDirHash
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected room with
# ->sourceCodePath set, but ->virtualAreaPath not set
@list = (
'view_source_code',
'edit_source_code',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedRoom
&& $self->selectedRoom->sourceCodePath
&& ! $self->selectedRoom->virtualAreaPath
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected room with
# ->virtualAreaPath set
@list = (
'view_virtual_area',
'edit_virtual_area',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedRoom
&& $self->selectedRoom->virtualAreaPath
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected room whose ->wildMode
# is not set to 'wild' (the value 'border' is ok, though)
@list = (
'add_normal_exit', 'add_hidden_exit',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedRoom
&& $self->selectedRoom->wildMode ne 'wild'
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, one or more selected rooms and
# $self->graffitiModeFlag set to TRUE
@list = (
'toggle_graffiti', 'icon_toggle_graffiti',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->selectedRoom || $self->selectedRoomHash)
&& $self->graffitiModeFlag
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and one or more selected rooms
@list = (
'move_rooms_dir', 'move_rooms_click',
'icon_move_to_click',
'toggle_room_flag_sub',
'reset_positions',
'room_exclusivity', 'room_exclusivity_sub',
'set_exits',
'add_multiple_exits',
'wilderness_normal',
'update_visits',
'delete_room',
'repaint_selected',
'set_virtual_area',
'reset_virtual_area',
'toggle_exclusivity',
'clear_exclusive_profs',
'connect_adjacent',
'icon_inc_visits', 'icon_dec_visits', 'icon_set_visits', 'icon_reset_visits',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->selectedRoom || $self->selectedRoomHash)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and either one or more selected rooms or one
# or more selected room guilds (or a mixture of both)
@list = (
'set_room_guild',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& (
$self->selectedRoom || $self->selectedRoomHash || $self->selectedRoomGuild
|| $self->selectedRoomGuildHash
)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and EITHER one or more selected rooms OR a
# current room
@list = (
'identify_room',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->selectedRoom || $self->selectedRoomHash || $self->mapObj->currentRoom)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, one or more selected rooms and at least two
# regions in the world model
@list = (
'transfer_to_region',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->selectedRoom || $self->selectedRoomHash)
&& $self->worldModelObj->ivPairs('regionmapHash') > 1
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, a current room and the automapper object
# being set up to perform a merge operation
@list = (
'move_merge_rooms',
);
if (
$self->currentRegionmap
&& $self->mapObj->currentRoom
&& $self->mapObj->currentMatchFlag
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and EITHER one or more selected rooms OR a
# current room and the automapper being set up to perform a merge)
@list = (
'move_rooms_labels',
);
if (
$self->currentRegionmap
&& (
$self->selectedRoom
|| $self->selectedRoomHash
|| ($self->mapObj->currentRoom && $self->mapObj->currentMatchFlag)
)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and an empty
# $self->currentRegionmap->gridRoomHash
@list = (
'add_first_room',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ! $self->currentRegionmap->gridRoomHash
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Meny items that require a current regionmap and a non-empty
# $self->currentRegionmap->gridRoomHash
@list = (
'recalculate_in_region',
'locate_room_in_current',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->currentRegionmap->gridRoomHash
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected exit
@list = (
'set_exit_dir',
'edit_exit',
'disconnect_exit',
'delete_exit',
'set_exit_type',
);
if ($self->currentRegionmap && $self->session->loginFlag && $self->selectedExit) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and one or more selected exits
@list = (
'set_ornament_sub',
'icon_no_ornament', 'icon_openable_exit', 'icon_lockable_exit',
'icon_pickable_exit', 'icon_breakable_exit', 'icon_impassable_exit',
'icon_mystery_exit',
'identify_exit',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->selectedExit || $self->selectedExitHash)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, a single selected exit and
# $self->selectedExit->drawMode is 'temp_alloc' or 'temp_unalloc'
@list = (
'allocate_map_dir',
'allocate_shadow',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedExit
&& (
$self->selectedExit->drawMode eq 'temp_alloc'
|| $self->selectedExit->drawMode eq 'temp_unalloc'
)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, a single selected exit and
# $self->selectedExit->drawMode is 'primary' or 'perm_alloc'
@list = (
'change_direction',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedExit
&& (
$self->selectedExit->drawMode eq 'primary'
|| $self->selectedExit->drawMode eq 'perm_alloc'
)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, a single selected exit and
# $self->selectedExit->drawMode is 'primary', 'temp_unalloc' or 'perm_alloc'
@list = (
'connect_to_click',
'set_assisted_move',
'icon_connect_click',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedExit
&& $self->selectedExit->drawMode ne 'temp_alloc'
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected exit which is a broken
# exit
@list = (
'toggle_bent_exit',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedExit
&& $self->selectedExit->brokenFlag
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected exit which is a region
# exit
@list = (
'set_super_sub',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedExit
&& $self->selectedExit->regionFlag
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and either a single selected exit which is a
# region exit, or a single selected exit tag
@list = (
'toggle_exit_tag',
'edit_tag_text',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& (
($self->selectedExit && $self->selectedExit->regionFlag)
|| $self->selectedExitTag
)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and one or more selected exits or selected
# exit tags
@list = (
'reset_exit_tags',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& (
$self->selectedExit || $self->selectedExitHash
|| $self->selectedExitTag || $self->selectedExitTagHash
)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected exit which is a
# super-region exit
@list = (
'recalculate_from_exit',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedExit
&& $self->selectedExit->superFlag
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected exit which is an
# uncertain exit or a one-way exit
@list = (
'set_exit_twin',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedExit
&& (
$self->selectedExit->oneWayFlag
|| (
$self->selectedExit->destRoom
&& ! $self->selectedExit->twinExit
&& ! $self->selectedExit->retraceFlag
&& $self->selectedExit->randomType eq 'none'
)
)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected exit which is a one-way
# exit
@list = (
'set_incoming_dir',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->selectedExit
&& $self->selectedExit->oneWayFlag
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a single selected label
@list = (
'set_label',
'customise_label',
);
if ($self->currentRegionmap && $self->session->loginFlag && $self->selectedLabel) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and one or more selected labels
@list = (
'delete_label',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->selectedLabel || $self->selectedLabelHash)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a selected region (in the treeview)
@list = (
'identify_region',
);
if ($self->treeViewSelectedLine) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, and $self->currentRegionmap->magnification
# to be within a certain range of values
@magList = $self->constMagnifyList;
@list = (
'zoom_out',
);
# (Don't try to zoom out, if already zoomed out to the maximum extent)
if (
$self->currentRegionmap
&& $self->currentRegionmap->magnification > $magList[0]
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
@list = (
'zoom_in',
);
# (Don't try to zoom in, if already zoomed in to the maximum extent)
if (
$self->currentRegionmap
&& $self->currentRegionmap->magnification < $magList[-1]
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and $self->worldModelObj->drawExitMode is
# 'ask_regionmap'
@list = (
'draw_region_exits',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& $self->worldModelObj->drawExitMode eq 'ask_regionmap'
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current character profile
@list = (
'report_visits_3',
);
if ($self->session->currentChar) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a current character profile
@list = (
'report_visits_4',
);
if ($self->currentRegionmap && $self->session->loginFlag && $self->session->currentChar) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current guild profile
@list = (
'report_guilds_3',
);
if ($self->session->currentGuild) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap whose ->gridColourBlockHash and/or
# ->gridColourObjHash is not empty)
@list = (
'empty_bg_colours',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& (
$self->currentRegionmap->gridColourBlockHash
|| $self->currentRegionmap->gridColourObjHash
)
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and a current guild profile
@list = (
'report_guilds_4',
);
if ($self->currentRegionmap && $self->session->loginFlag && $self->session->currentGuild) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require assisted moves to be turned on
@list = (
'allow_protected_moves',
'allow_super_protected_moves',
);
if ($self->worldModelObj->assistedMovesFlag) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require protected moves to be turned off
@list = (
'allow_crafty_moves',
);
if (! $self->worldModelObj->protectedMovesFlag) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require basic mapping mode to be turned off
@list = (
'paint_wild', 'icon_paint_wild',
'paint_border', 'icon_paint_border',
);
if (! $self->session->currentWorld->basicMappingFlag) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap, one or more selected rooms and basic mapping
# mode to be turned off
@list = (
'wilderness_wild', 'wilderness_border',
);
if (
$self->currentRegionmap
&& $self->session->loginFlag
&& ($self->selectedRoom || $self->selectedRoomHash)
&& ! $self->session->currentWorld->basicMappingFlag
) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a non-empty list of preferred room flags
@list = (
'icon_remove_room_flag', 'icon_remove_room_flag_2',
);
if ($self->worldModelObj->preferRoomFlagList) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a non-empty list of preferred background colours
@list = (
'icon_bg_remove',
);
if ($self->worldModelObj->preferBGColourList) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap and at least one non-default colour scheme
@list = (
'attach_region_scheme',
);
if ($self->currentRegionmap && $self->worldModelObj->ivPairs('regionSchemeHash') > 1) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require a current regionmap with a non-default region scheme attached
@list = (
'detach_region_scheme',
);
if ($self->currentRegionmap && defined $self->currentRegionmap->regionScheme) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Menu items that require at least one map label style
@list = (
'edit_style',
);
if ($self->worldModelObj->mapLabelStyleHash) {
push (@sensitiseList, @list);
} else {
push (@desensitiseList, @list);
}
# Sensitise and desensitise menu items and toolbar buttons, as required
$self->sensitiseWidgets(@sensitiseList);
$self->desensitiseWidgets(@desensitiseList);
return 1;
}
sub sensitiseWidgets {
# Called by anything. Frequently called by $self->restrictWidgets
# Given a list of Gtk3 widgets (all of them menu/toolbar items), sets them as sensitive
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# @widgetList - A list of widgets - keys in the hash $self->menuToolItemHash
# (e.g. 'move_up_level')
#
# Return values
# 1
my ($self, @widgetList) = @_;
# (No improper arguments to check)
foreach my $widgetName (@widgetList) {
my $widget = $self->ivShow('menuToolItemHash', $widgetName);
if ($widget) {
$widget->set_sensitive(TRUE);
}
}
return 1;
}
sub desensitiseWidgets {
# Called by anything. Frequently called by $self->restrictWidgets
# Given a list of Gtk3 widgets (all of them menu/toolbar items), sets them as insensitive
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# @widgetList - A list of widgets - keys in the hash $self->menuToolItemHash
# (e.g. 'move_up_level')
#
# Return values
# 1
my ($self, @widgetList) = @_;
# (No improper arguments to check)
foreach my $widgetName (@widgetList) {
my $widget = $self->ivShow('menuToolItemHash', $widgetName);
if ($widget) {
$widget->set_sensitive(FALSE);
}
}
return 1;
}
sub setActiveItem {
# Can be called by anything, but mostly called by functions in GA::Obj::WorldModel that want
# to set a menu bar or toolbar item as active (or not)
#
# Expected arguments
# $widgetName - The widget's name, a key in the hash $self->menuToolItemHash
#
# Optional arguments
# $flag - Any TRUE value to set the menu bar/toolbar item as active, any FALSE value
# (including 'undef') to set the item as not active
#
# Return values
# 'undef' on improper arguments or if $widgetName doesn't appear in
# $self->menuToolItemHash
# 1 otherwise
my ($self, $widgetName, $flag, $check) = @_;
# Local variables
my $widget;
# Check for improper arguments
if (! defined $widgetName || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setActiveItem', @_);
}
$widget = $self->ivShow('menuToolItemHash', $widgetName);
if (! defined $widget) {
return undef;
} else {
if (! $flag) {
$widget->set_active(FALSE);
} else {
$widget->set_active(TRUE);
}
return 1;
}
}
sub restrictUpdateMode {
# Called by $self->setMode
# Sensitises or desensitises the menu and toolbar buttons that allow the user to switch to
# update mode, depending on the value of GA::Obj::WorldModel->disableUpdateModeFlag and
# GA::Session->status
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($radioMenuItem, $toolbarButton);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->restrictUpdateMode', @_);
}
# Mark the radio/toolbar buttons for 'update mode' as sensitive, or not
$radioMenuItem = $self->ivShow('menuToolItemHash', 'set_update_mode');
$toolbarButton = $self->ivShow('menuToolItemHash', 'icon_set_update_mode');
if ($self->worldModelObj->disableUpdateModeFlag || $self->session->status eq 'offline') {
if ($radioMenuItem) {
$radioMenuItem->set_sensitive(FALSE);
}
if ($toolbarButton) {
$toolbarButton->set_sensitive(FALSE);
}
} else {
if ($radioMenuItem) {
$radioMenuItem->set_sensitive(TRUE);
}
if ($toolbarButton) {
$toolbarButton->set_sensitive(TRUE);
}
}
return 1;
}
# Pause windows handlers
sub showPauseWin {
# Can be called by anything
# Makes the pause window visible (a 'dialogue' window used only by this automapper)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->showPauseWin', @_);
}
if (! $axmud::CLIENT->busyWin) {
# Show the window widget
$self->showBusyWin(
$axmud::SHARE_DIR . '/icons/system/mapper.png',
'Working...',
);
}
return 1;
}
sub hidePauseWin {
# Can be called by anything
# Makes the pause window invisible
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->hidePauseWin', @_);
}
if ($axmud::CLIENT->busyWin) {
$self->closeDialogueWin($axmud::CLIENT->busyWin);
}
return 1;
}
# Canvas callbacks
sub setupCanvasEvent {
# Called by $self->resetMap() to create an anonymous function to intercept signals from the
# map background, filter out the signals we don't want, and pass the signals we do want to
# an event handler
# Because the background is at the 'bottom', the anonymous function is only called when the
# user is clicking on an empty part of the map
# Also called by $self->drawRoomEcho when the user clicks on a room echo, which we should
# treat as if it were a click on the map background
#
# Expected arguments
# $canvasObj - The GooCanvas2::CanvasRect which is the map's background (or the
# GooCanvas2::CanvasRect which is a room echo, which should be treated
# as part of the map background)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $canvasObj, $check) = @_;
# Check for improper arguments
if (! defined $canvasObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setupCanvasEvent', @_);
}
$canvasObj->signal_connect('button_press_event' => sub {
my ($item, $target, $event) = @_;
# If the tooltips are visible, hide them
$self->hideTooltips();
# All clicks on the canvas itself are handled by this function
$self->canvasEventHandler($canvasObj, $event);
});
$canvasObj->signal_connect('button_release_event' => sub {
my ($item, $target, $event) = @_;
# If the tooltips are visible, hide them
$self->hideTooltips();
# All clicks on the canvas itself are handled by this function
$self->canvasEventHandler($canvasObj, $event);
});
$canvasObj->signal_connect('motion_notify_event' => sub {
my ($item, $target, $event) = @_;
if ($self->selectBoxFlag && $event->state =~ m/button1-mask/) {
# Continue the selection box operation by re-drawing the canvas object at its new
# position
$self->continueSelectBox($event);
}
});
# Setup complete
return 1;
}
sub setupCanvasObjEvent {
# Called by various functions to create an anonymous function to intercept signals from
# canvas objects above the map background, filter out the signals we don't want, and pass
# the signals we do want to an event handler
# Because canvas objects are 'above' the background, the anonymous function (and not the
# one in $self->setupCanvasEvent) is called when the user clicks on a coloured block,
# rectangle, room, room tag, room guild, exit or label directly
#
# Expected arguments
# $type - What type of canvas object this is - 'room', 'room_tag', 'room_guild',
# 'exit', 'exit_tag', 'label', 'square' or 'rect'
# $canvasObj - The canvas object on which the user has clicked (i.e.
# GooCanvas2::CanvasRect, GooCanvas2::CanvasPath,
# GooCanvas2::CanvasEllipse or GooCanvas2::CanvasText)
#
# Optional arguments
# $modelObj - The GA::ModelObj::Room, GA::Obj::Exit or GA::Obj::MapLabel which is
# represented by this canvas object. 'undef' for coloured blocks or
# rectangles, which can't be clicked
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $type, $canvasObj, $modelObj, $check) = @_;
# Check for improper arguments
if (! defined $type || ! defined $canvasObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setupCanvasObjEvent', @_);
}
$canvasObj->signal_connect('button_press_event' => sub {
my ($item, $target, $event) = @_;
# Coloured blocks/rectangles can't be clicked; treat a click on one of these canvas
# objects as if it was a click on the map background
if (! $modelObj) {
$self->canvasEventHandler($canvasObj, $event);
# For left-clicks, if the Alt-Gr key is pressed down (or if we're in drag mode), it's a
# drag operation
} elsif (
$event->button == 1 && ($event->state =~ m/mod5-mask/ || $self->dragModeFlag)
) {
# Respond to the start of a drag operation
$self->startDrag(
$type,
$canvasObj,
$modelObj,
$event,
$event->x_root,
$event->y_root,
);
# All other clicks on a canvas object are handled by the event handler
} elsif ($event->type eq 'button-press' || $event->type eq '2button-press') {
$self->canvasObjEventHandler($type, $canvasObj, $modelObj, $event);
}
});
$canvasObj->signal_connect('button_release_event' => sub {
my ($item, $target, $event) = @_;
if (! $modelObj) {
$self->canvasEventHandler($canvasObj, $event);
} elsif (
$self->dragFlag
&& (
$canvasObj eq $self->dragCanvasObj
# When dragging labels with a box, there are two canvas objects
|| $self->ivFind('dragCanvasObjList', $canvasObj)
)
) {
# Respond to the end of a drag operation
$self->stopDrag($event, $event->x_root, $event->y_root);
}
});
$canvasObj->signal_connect('motion_notify_event' => sub {
my ($item, $target, $event) = @_;
if (! $modelObj) {
if ($self->selectBoxFlag && $event->state =~ m/button1-mask/) {
# Continue the selection box operation by re-drawing the canvas object at its
# new position
$self->continueSelectBox($event);
} else {
$self->canvasEventHandler($canvasObj, $event);
}
# Process mouse events - when the mouse moves over a canvas object, or leaves it -
# in order to display tooltips, etc
} elsif (
$self->dragFlag
&& (
$canvasObj eq $self->dragCanvasObj
# When dragging labels with a box, there are two canvas objects
|| $self->ivFind('dragCanvasObjList', $canvasObj)
)
&& $event->state =~ m/button1-mask/
) {
# Continue the drag operation by re-drawing the object(s) at their new position
$self->continueDrag($event, $event->x_root, $event->y_root);
}
});
$canvasObj->signal_connect('enter_notify_event' => sub {
my ($item, $target, $event) = @_;
if ($modelObj && $self->worldModelObj->showTooltipsFlag && ! $self->canvasTooltipObj) {
# Show the tooltips window
$self->showTooltips($type, $canvasObj, $modelObj);
}
});
$canvasObj->signal_connect('leave_notify_event' => sub {
my ($item, $target, $event) = @_;
if (
$modelObj
&& $self->canvasTooltipFlag
&& $self->canvasTooltipObj eq $canvasObj
&& $self->canvasTooltipObjType eq $type
) {
# Hide the tooltips window
$self->hideTooltips();
}
});
# Setup complete
return 1;
}
sub canvasEventHandler {
# Handles events on the map background (i.e. clicking on an empty part of the background
# which doesn't contain a room, room tag, room guild, exit, exit tag, label, or checked
# direction)
# The calling function, an anonymous sub defined in $self->setupCanvasEvent, filters out the
# signals we don't want
# At the moment, the signals let through the filter are:
# button_press, 2button_press, 3button_press, button_release
#
# Expected arguments
# $canvasObj - The canvas object which intercepted an event signal
# $event - The Gtk3::Gdk::Event that caused the signal
#
# Return values
# 'undef' on improper arguments, if there is no region map or if the signal $event is one
# that this function doesn't handle
# 1 otherwise
my ($self, $canvasObj, $event, $check) = @_;
# Local variables
my (
$clickXPosPixels, $clickYPosPixels, $clickType, $button, $shiftFlag, $ctrlFlag,
$clickXPosBlocks, $clickYPosBlocks, $newRoomObj, $roomNum, $roomObj, $exitObj, $listRef,
$result, $twinExitObj, $result2, $popupMenu,
);
# Check for improper arguments
if (! defined $canvasObj || ! defined $event || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->canvasEventHandler', @_);
}
# Don't do anything if there is no current regionmap
if (! $self->currentRegionmap) {
return undef;
}
# In case the previous click on the canvas was a right-click on an exit, we no longer need
# the coordinates of the click
$self->ivUndef('exitClickXPosn');
$self->ivUndef('exitClickYPosn');
# Get the coordinates on the map of the clicked pixel. If the map is magnified we might get
# fractional values, so we need to use int()
($clickXPosPixels, $clickYPosPixels) = (int($event->x), int($event->y));
# For mouse button clicks, get the click type and whether or not the SHIFT and/or CTRL keys
# were held down
($clickType, $button, $shiftFlag, $ctrlFlag) = $self->checkMouseClick($event);
if (! $clickType) {
# Not an event in which we're interested
return undef;
}
# Work out which gridblock is underneath the mouse click
($clickXPosBlocks, $clickYPosBlocks) = $self->findGridBlock(
$clickXPosPixels,
$clickYPosPixels,
$self->currentRegionmap,
);
# If $self->freeClickMode and/or $self->bgColourMode aren't set to 'default', left-clicking
# on empty space causes something unusual to happen
if (
$clickType eq 'single'
&& $button eq 'left'
&& ($self->freeClickMode ne 'default' || $self->bgColourMode ne 'default')
) {
# Free click mode 'add_room' - 'Add room at click' menu option
# (NB If this code is altered, the equivalent code in ->enableCanvasPopupMenu must also
# be altered)
if ($self->freeClickMode eq 'add_room') {
# Only add one new room
$self->reset_freeClickMode();
$newRoomObj = $self->mapObj->createNewRoom(
$self->currentRegionmap,
$clickXPosBlocks,
$clickYPosBlocks,
$self->currentRegionmap->currentLevel,
);
# When using the 'Add room at block' menu item, the new room is selected to make it
# easier to see where it was drawn
# To make things consistent, select this new room, too
$self->setSelectedObj(
[$newRoomObj, 'room'],
FALSE, # Select this object; unselect all other objects
);
# Free click mode 'connect_exit' - 'Connect exit to click' menu option
# Free click mode 'merge_room' - 'Merge/move rooms' menu option
} elsif (
$self->freeClickMode eq 'connect_exit'
|| $self->freeClickMode eq 'merge_room'
) {
# If the user has selected the either of these menu option, $self->freeClickMode has
# been set and we're waiting for a click on a room; since this part of the grid is
# not occupied by a room, we can cancel it now
$self->reset_freeClickMode();
# Free click mode 'add_label' - 'Add label at click' menu option
} elsif ($self->freeClickMode eq 'add_label') {
$self->addLabelAtClickCallback($clickXPosPixels, $clickYPosPixels);
# Only add one new label
$self->reset_freeClickMode();
# Free click mode 'move_room' - 'Move selected rooms to click' menu option
} elsif ($self->freeClickMode eq 'move_room') {
$self->moveRoomsToClick($clickXPosBlocks, $clickYPosBlocks);
# Only do it once
$self->reset_freeClickMode();
# Background colour mode 'square_start' (no menu option)
} elsif ($self->freeClickMode eq 'default' && $self->bgColourMode eq 'square_start') {
$self->setColouredSquare($clickXPosBlocks, $clickYPosBlocks);
# Background colour mode 'rect_start' (no menu option)
} elsif ($self->freeClickMode eq 'default' && $self->bgColourMode eq 'rect_start') {
# Store the coordinates of the click, and wait for the second click
$self->ivPoke('bgColourMode', 'rect_stop');
$self->ivPoke('bgRectXPos', $clickXPosBlocks);
$self->ivPoke('bgRectYPos', $clickYPosBlocks);
# Background colour mode 'rect_stop' (no menu option)
} elsif ($self->freeClickMode eq 'default' && $self->bgColourMode eq 'rect_stop') {
$self->setColouredRect($clickXPosBlocks, $clickYPosBlocks);
}
# Non-default operation complete
return 1;
}
# Otherwise, see if there's a room inside the gridblock that was clicked (if there is, we
# will be able to detect clicks near exits)
$roomNum = $self->currentRegionmap->fetchRoom(
$clickXPosBlocks,
$clickYPosBlocks,
$self->currentRegionmap->currentLevel,
);
if (defined $roomNum) {
$roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
}
if ($roomObj && $clickType eq 'single' && $self->currentRegionmap->gridExitHash) {
# Usually, when we click on the map on an empty pixel, all selected objects are
# unselected
# However, because exits are often drawn only 1 pixel wide, they're quite difficult to
# click on. This section checks whether the mouse click occured close enough to an
# exit
# A left-click near an exit causes the exit to be selected/unselected. A right-click
# selects the exit (unselecting everything else) and opens a popup menu for that exit.
# If the click isn't close enough to an exit, the user is deemed to have clicked in
# open space
# (NB If no exits have been drawn, don't bother checking)
# Now we check if they clicked near an exit, or in open space
$exitObj = $self->findClickedExit(
$clickXPosPixels,
$clickYPosPixels,
$roomObj,
$self->currentRegionmap,
);
if ($exitObj) {
if ($button eq 'left' && $event->state =~ m/mod5-mask/) {
# This is a drag operation on the nearby exit
$listRef = $self->currentParchment->getDrawnExit($exitObj);
if (defined $listRef) {
$self->startDrag(
'exit',
$$listRef[0], # The exit's canvas object
$exitObj,
$event,
$clickXPosPixels,
$clickYPosPixels,
);
}
} elsif ($button eq 'left') {
# If this exit (and/or its twin) is a selected exit, unselect them
$result = $self->unselectObj($exitObj);
if ($exitObj->twinExit) {
$twinExitObj
= $self->worldModelObj->ivShow('exitModelHash', $exitObj->twinExit);
if ($twinExitObj) {
$result2 = $self->unselectObj($twinExitObj);
}
}
if (! $result && ! $result2) {
# The exit wasn't already selected, so select it
$self->setSelectedObj(
[$exitObj, 'exit'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
}
} elsif ($button eq 'right') {
# Select the exit, unselecting all other selected objects
$self->setSelectedObj(
[$exitObj, 'exit'],
FALSE, # Select this object; unselect all other objects
);
# Create the popup menu
if ($self->selectedExit) {
$popupMenu = $self->enableExitsPopupMenu();
if ($popupMenu) {
$popupMenu->popup(
undef, undef, undef, undef,
$event->button,
$event->time,
);
}
}
}
return 1;
}
}
# Otherwise, the user clicked in open space
# If it was a right-click, open a popup menu
if ($clickType eq 'single' && $button eq 'right') {
$popupMenu = $self->enableCanvasPopupMenu(
$clickXPosPixels,
$clickYPosPixels,
$clickXPosBlocks,
$clickYPosBlocks,
);
if ($popupMenu) {
$popupMenu->popup(
undef, undef, undef, undef,
$event->button,
$event->time,
);
}
# If it was a left-click, it's potentially a selection box operation
} elsif ($clickType eq 'single' && $button eq 'left') {
# The selection box isn't actually drawn until the user moves their mouse. If they
# release the button instead, at that point we unselect all selected objects
$self->startSelectBox($clickXPosPixels, $clickYPosPixels);
# If it's a mouse button release, handle the end of any selection box operation
} elsif ($clickType eq 'release' && $button eq 'left' && $self->selectBoxFlag) {
$self->stopSelectBox($event, $clickXPosPixels, $clickYPosPixels);
# Otherwise, if it's a button click (not a button release), just unselect all selected
# objects
} elsif ($clickType ne 'release') {
$self->setSelectedObj();
}
return 1;
}
sub canvasObjEventHandler {
# Handles events on canvas object (i.e. clicking on a room, room tag, room guild, exit,
# exit tag or label). Note that clicks on canvas objects for checked directions are
# ignored; they are not handled by this function nor by $self->canvasEventHandler
# The calling function, an anonymous sub defined in $self->setupCanvasObjEvent, filters out
# the signals we don't want
# At the moment, the signals let through the filter are:
# button_press, 2button_press
#
# Expected arguments
# $objType - 'room', 'room_tag', 'room_guild', 'exit', 'exit_tag' or 'label'
# $canvasObj - The canvas object which intercepted an event signal
# $modelObj - The GA::ModelObj::Room, GA::Obj::Exit or GA::Obj::MapLabel which is
# represented by this canvas object
# $event - The Gtk3::Gdk::Event that caused the signal
#
# Return values
# 'undef' on improper arguments or if the signal $event is one that this function doesn't
# handle
# 1 otherwise
my ($self, $objType, $canvasObj, $modelObj, $event, $check) = @_;
# Local variables
my (
$clickType, $button, $shiftFlag, $ctrlFlag, $selectFlag, $clickTime, $otherRoomObj,
$startX, $stopX, $startY, $stopY, $result, $twinExitObj, $result2, $popupMenu,
);
# Check for improper arguments
if (
! defined $objType || ! defined $canvasObj || ! defined $modelObj || ! defined $event
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->canvasObjEventHandler', @_);
}
# In case the previous click on the canvas was a right-click on an exit, we no longer need
# the coordinates of the click
$self->ivUndef('exitClickXPosn');
$self->ivUndef('exitClickYPosn');
# If $self->freeClickMode has been set to 'add_room' or 'add_label' by the 'Add room at
# click' or 'Add label at click' menu options, since this part of the grid is already
# occupied, we can go back to normal
if ($self->freeClickMode eq 'add_room' || $self->freeClickMode eq 'add_label') {
$self->reset_freeClickMode();
}
# For mouse button clicks, get the click type and whether or not the SHIFT and/or CTRL keys
# were held down
($clickType, $button, $shiftFlag, $ctrlFlag) = $self->checkMouseClick($event);
if (! $clickType) {
# Not an event in which we're interested
return undef;
}
# Various parts of the function check that these hashes contain at least one item between
# them
if (
$self->selectedRoomHash || $self->selectedRoomTagHash || $self->selectedRoomGuildHash
|| $self->selectedExitHash || $self->selectedExitTagHash || $self->selectedLabelHash
) {
$selectFlag = TRUE;
}
# For capturing double-clicks on rooms, we need to compare the times at which each click is
# received
$clickTime = $axmud::CLIENT->getTime();
# Process single left clicks
if ($clickType eq 'single' && $button eq 'left') {
# Process a left-clicked room differently, if ->freeClickMode has been set to
# 'connect_exit' by the 'Connect to click' menu option (ignoring the SHIFT/CTRL keys)
if ($self->freeClickMode eq 'connect_exit' && $objType eq 'room') {
# Occasionally get an error, when there's no selected exit. $self->freeClickMode
# should get reset, but not in these situations
if (! $self->selectedExit) {
$self->reset_freeClickMode();
} else {
# Get the selected exit's parent room, and the room's parent region
$otherRoomObj
= $self->worldModelObj->ivShow('modelHash', $self->selectedExit->parent);
# If that room and the clicked room are in the same region...
if ($otherRoomObj && $modelObj->parent == $otherRoomObj->parent) {
# The two rooms are in the same region, so it's (possibly) a broken exit
$self->connectExitToRoom($modelObj, 'broken');
} else {
# The two rooms are in different regions, so it's a region exit
$self->connectExitToRoom($modelObj, 'region');
}
# Only do it once
$self->reset_freeClickMode();
}
# Process a left-clicked room differently, if ->freeClickMode has been set to
# 'move_room' by the 'Move selected rooms to click' menu option (ignoring the
# SHIFT/CTRL keys)
} elsif ($self->freeClickMode eq 'move_room' && $objType eq 'room') {
$self->moveRoomsToExit($modelObj);
# Only do it once
$self->reset_freeClickMode();
# Process a left-clicked room differently, if ->toolbarQuickPaintColour is set (ignoring
# the SHIFT/CTRL keys)
} elsif ($self->toolbarQuickPaintColour && $objType eq 'room') {
$self->doQuickPaint($modelObj);
# Process a left-clicked room differently, if ->freeClickMode has been set to
# 'merge_room' by the 'Merge/move rooms' menu option (ignoring the SHIFT/CTRL keys)
} elsif ($self->freeClickMode eq 'merge_room' && $objType eq 'room') {
$self->doMerge($self->mapObj->currentRoom, $modelObj);
# Only do it once
$self->reset_freeClickMode();
# Process left-clicked rooms (ignoring the CTRL key, but checking for the SHIFT key)
} elsif (
$objType eq 'room'
&& $shiftFlag
&& ($self->selectedRoom || $self->selectedRoomHash)
) {
# Find the coordinates of opposite corners (top-left and bottom-right) of the area
# of the grid which contains currently selected rooms
($startX, $startY, $stopX, $stopY) = $self->findSelectedRoomArea();
# If there are no selected rooms on this level...
if (! defined $startX) {
# Select this room, only
$startX = $modelObj->xPosBlocks;
$startY = $modelObj->yPosBlocks;
$stopX = $modelObj->xPosBlocks;
$stopY = $modelObj->yPosBlocks;
# Otherwise, if the clicked room is selected...
} elsif ($self->checkRoomIsSelected($modelObj)) {
# If the clicked room is at the top-left of the area containing selected rooms,
# select only this room, and unselect all the others
if ($modelObj->xPosBlocks == $startX && $modelObj->yPosBlocks == $startY) {
$stopX = $startX;
$stopY = $startY;
# Otherwise, the clicked room is the new bottom-right of the selected area
} else {
$stopX = $modelObj->xPosBlocks;
$stopY = $modelObj->yPosBlocks;
}
# ...but if the clicked room isn't selected...
} else {
# If the clicked room's x-coordinate is to the left of the area's starting
# x-coordinate, change the area's starting x co-ordinate
if ($modelObj->xPosBlocks < $startX) {
$startX = $modelObj->xPosBlocks;
# Likewise for the other three corners
} elsif ($modelObj->xPosBlocks > $stopX) {
$stopX = $modelObj->xPosBlocks;
}
if ($modelObj->yPosBlocks < $startY) {
$startY = $modelObj->yPosBlocks;
} elsif ($modelObj->yPosBlocks > $stopY) {
$stopY = $modelObj->yPosBlocks;
}
}
# Select all rooms in the (modified) area, and unselect all rooms outside it (along
# with any selected exits, room tags and labels)
$self->selectRoomsInArea($startX, $startY, $stopX, $stopY);
# Process double-clicked rooms
} elsif (
$objType eq 'room'
&& $button eq 'left'
&& ! $shiftFlag
&& ! $ctrlFlag
&& $self->worldModelObj->quickPathFindFlag
&& $self->mapObj->currentRoom
&& $self->leftClickTime
&& ($self->leftClickTime + $self->leftClickWaitTime) > $clickTime
&& $self->leftClickObj eq $modelObj
) {
# Double-click detected. Reset IVs
$self->ivUndef('leftClickTime');
$self->ivUndef('leftClickObj');
# Don't do anything if the user clicked on the current room and the automapper
# object isn't set up to perform a merge
if ($modelObj eq $self->mapObj->currentRoom) {
if ($self->mapObj->currentMatchFlag) {
$self->doMerge($modelObj);
}
} else {
# Ensure the double-clicked room is the only one selected...
$self->setSelectedObj(
[$modelObj, 'room'],
FALSE, # Select this object; unselect all other objects
);
# ...so the callback function knows which room is the destination room
return $self->processPathCallback('send_char');
}
# Process left-clicked room tags (ignoring the SHIFT key, but checking for the CTRL key)
} elsif ($objType eq 'room_tag') {
# If a group of things are already selected, unselect them all and select the object
# that was clicked
if (! $ctrlFlag && $selectFlag) {
# Select this room tag, unselecting all other objects
$self->setSelectedObj(
[$modelObj, 'room_tag'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
} else {
# If this object is already a selected object, unselect it
if (! $self->unselectObj($modelObj, 'room_tag')) {
# The room tag wasn't already selected, so select it
$self->setSelectedObj(
[$modelObj, 'room_tag'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
}
}
# Process left-clicked room guilds (ignoring the SHIFT key, but checking for the CTRL
# key)
} elsif ($objType eq 'room_guild') {
# If a group of things are already selected, unselect them all and select the object
# that was clicked
if (! $ctrlFlag && $selectFlag) {
# Select this room guild, unselecting all other objects
$self->setSelectedObj(
[$modelObj, 'room_guild'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
} else {
# If this object is already a selected object, unselect it
if (! $self->unselectObj($modelObj, 'room_guild')) {
# The room guild wasn't already selected, so select it
$self->setSelectedObj(
[$modelObj, 'room_guild'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
}
}
# Process left-clicked exits (ignoring the SHIFT key, but checking for the CTRL key)
} elsif ($objType eq 'exit') {
# For twin exits - which share a canvas object - use the exit whose parent room is
# closest to the click
$modelObj = $self->chooseClickedExit($modelObj, int($event->x), int($event->y));
# If a group of things are already selected, unselect them all and select the object
# that was clicked
if (! $ctrlFlag && $selectFlag) {
# Select this exit, unselecting all other objects
$self->setSelectedObj(
[$modelObj, 'exit'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
} else {
# If this exit (and/or its twin) is a selected exit, unselect them
$result = $self->unselectObj($modelObj);
if ($modelObj->twinExit) {
$twinExitObj
= $self->worldModelObj->ivShow('exitModelHash', $modelObj->twinExit);
if ($twinExitObj) {
$result2 = $self->unselectObj($twinExitObj);
}
}
if (! $result && ! $result2) {
# The exit wasn't already selected, so select it
$self->setSelectedObj(
[$modelObj, 'exit'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
}
}
# Process left-clicked exit tags (ignoring the SHIFT key, but checking for the CTRL key)
} elsif ($objType eq 'exit_tag') {
# If a group of things are already selected, unselect them all and select the object
# that was clicked
if (! $ctrlFlag && $selectFlag) {
# Select this exit tag, unselecting all other objects
$self->setSelectedObj(
[$modelObj, 'exit_tag'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
} else {
# If this object is already a selected object, unselect it
if (! $self->unselectObj($modelObj, 'exit_tag')) {
# The exit tag wasn't already selected, so select it
$self->setSelectedObj(
[$modelObj, 'exit_tag'],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
}
}
# Process other kinds of left-click
} else {
if ($objType eq 'room' && ! $shiftFlag && ! $ctrlFlag) {
# Single click detected; it might be the start of a double-click
$self->ivPoke('leftClickTime', $clickTime);
$self->ivPoke('leftClickObj', $modelObj);
}
# If a group of things are already selected, unselect them all and select the object
# that was clicked
if (! $ctrlFlag && $selectFlag) {
# Select this room/label, unselecting all other objects
$self->setSelectedObj(
[$modelObj, $objType],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
} else {
# If this object is already a selected object, unselect it
if (! $self->unselectObj($modelObj)) {
# The room or label wasn't already selected, so select it
$self->setSelectedObj(
[$modelObj, $objType],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
}
}
}
# Process right-clicks
} elsif ($clickType eq 'single' && $button eq 'right') {
if ($objType eq 'exit') {
# For twin exits - which share a canvas object - use the exit whose parent room is
# closest to the click
$modelObj = $self->chooseClickedExit($modelObj, int($event->x), int($event->y));
}
# If a group of things are already selected, unselect them all and select the object
# that was clicked
if ($selectFlag) {
# Select this room/label, unselecting all other objects
$self->setSelectedObj(
[$modelObj, $objType],
# Retain other selected objects if CTRL key held down
$ctrlFlag,
);
} else {
# If this object isn't already selected, select it (but don't unselect something
# as we would for a left-click)
if ($objType eq 'room_tag') {
$self->setSelectedObj(
[$modelObj, 'room_tag'],
FALSE, # Select this object; unselect all other objects
);
} elsif ($objType eq 'room_guild') {
$self->setSelectedObj(
[$modelObj, 'room_guild'],
FALSE, # Select this object; unselect all other objects
);
} elsif ($objType eq 'exit_tag') {
$self->setSelectedObj(
[$modelObj, 'exit_tag'],
FALSE, # Select this object; unselect all other objects
);
} else {
$self->setSelectedObj(
[$modelObj, $objType],
FALSE, # Select this object; unselect all other objects
);
}
}
# Create the popup menu
if ($objType eq 'room' && $self->selectedRoom) {
$popupMenu = $self->enableRoomsPopupMenu();
} elsif ($objType eq 'room_tag' && $self->selectedRoomTag) {
$popupMenu = $self->enableRoomTagsPopupMenu();
} elsif ($objType eq 'room_guild' && $self->selectedRoomGuild) {
$popupMenu = $self->enableRoomGuildsPopupMenu();
} elsif ($objType eq 'exit_tag' && $self->selectedExitTag) {
$popupMenu = $self->enableExitTagsPopupMenu();
} elsif ($objType eq 'exit' && $self->selectedExit) {
# Store the position of the right-click, in case the user wants to add a bend from
# the popup menu
$self->ivPoke('exitClickXPosn', int($event->x));
$self->ivPoke('exitClickYPosn', int($event->y));
# Now we can open the poup menu
$popupMenu = $self->enableExitsPopupMenu();
} elsif ($objType eq 'label' && $self->selectedLabel) {
$popupMenu = $self->enableLabelsPopupMenu();
}
if ($popupMenu) {
$popupMenu->popup(undef, undef, undef, undef, $event->button, $event->time);
}
}
return 1;
}
sub deleteCanvasObj {
# Called by numerous functions
#
# When a region object, room object, room tag, room guild, exit, exit tag or label is being
# drawn, redrawn or deleted from the world model, this function must be called
# The function checks whether the model object is currently drawn on a map as one or more
# canvas objects and, if it is, destroys the canvas objects
#
# This function also handles coloured blocks and rectangles on the background map, details
# of which are stored in the regionmap object (GA::Obj::Regionmap), not the world model
# The function checks whether a canvas object for the coloured block/rectangle is currently
# displayed on the map as a canvas object and, if so, destroys the canvas object
#
# Expected arguments
# $type - Set to 'region', 'room', 'room_tag', 'room_guild', 'exit', 'exit_tag' or
# 'label' for world model objects, 'checked_dir' for checked directions
# and 'square', 'rect' for coloured blocks/rectangles
# $modelObj - The GA::ModelObj::Region, GA::ModelObj::Room, GA::Obj::Exit or
# GA::Obj::MapLabel being drawn /redrawn / deleted
# - For checked directions, the GA::ModelObj::Room in which the checked
# direction is stored
# - For coloured squares, it's not a blessed reference, but a coordinate in
# the form 'x_y' (to delete canvas objects on all levels), or 'x_y_z' (to
# delete the canvas object on one level)
# - For coloured rectangles, it's not a blessed reference, but a key in the
# form 'object-number' (to delete canvas objects on all levels), or
# 'object-number_level' (to delete the canvas object on one level)
#
# Optional arguments
# $regionmapObj, $parchmentObj
# - The regionmap and parchment object for $modelObj. If not set, this
# function fetches them. Both must be specified if $type is 'square' or
# 'rect')
# $deleteFlag - Set to TRUE if the object is being deleted from the world model, FALSE
# (or 'undef') if not. Never TRUE for coloured blocks/rectangles which
# are not stored in the world model
#
# Return values
# 'undef' on improper arguments, if there's an error or if there are no canvas objects to
# destroy
# 1 otherwise
my ($self, $type, $modelObj, $regionmapObj, $parchmentObj, $deleteFlag, $check) = @_;
# Local variables
my (
$roomObj,
@redrawList,
%redrawHash,
);
# Check for improper arguments
if (! defined $type || ! defined $modelObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->deleteCanvasObj', @_);
}
# Fetch the regionmap and parchment object, if not specified
if (! $regionmapObj) {
if ($type eq 'region') {
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $modelObj->name);
} elsif (
$type eq 'room' || $type eq 'room_tag' || $type eq 'room_guild'
|| $type eq 'checked_dir'
) {
$regionmapObj = $self->findRegionmap($modelObj->parent);
} elsif ($type eq 'exit' || $type eq 'exit_tag') {
$roomObj = $self->worldModelObj->ivShow('modelHash', $modelObj->parent);
$regionmapObj = $self->findRegionmap($roomObj->parent);
} elsif ($type eq 'label') {
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $modelObj->region);
} else {
# $type is 'square' or 'rect', for which $regionmapObj should have been be specified
return undef;
}
}
if ($regionmapObj && ! $parchmentObj) {
$parchmentObj = $self->ivShow('parchmentHash', $regionmapObj->name);
}
if (! $parchmentObj) {
# No parchment object for this region exists, so there are no canvas objects to destroy
return undef;
}
# Handle a region deletion
if ($type eq 'region' && $deleteFlag) {
# Reset the treeview, so that the deleted region is no longer visible in it
$self->resetTreeView();
if ($self->currentRegionmap && $self->currentRegionmap eq $regionmapObj) {
# The currently displayed region was the one deleted. Draw an empty map
$self->resetMap();
} else {
# Redraw all rooms containing region exits (which automatically redraws the exits)
foreach my $otherRegionmap ($self->worldModelObj->ivValues('regionmapHash')) {
# The same room can have more than one region exit; add affected rooms to a hash
# to eliminate duplicates
foreach my $number ($otherRegionmap->ivKeys('regionExitHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if ($exitObj) {
$redrawHash{$exitObj->parent} = undef;
}
}
}
# Having eliminated duplicates, compile the list of rooms to redraw
foreach my $number (keys %redrawHash) {
my $thisRoomObj = $self->worldModelObj->ivShow('modelHash', $number);
if ($thisRoomObj) {
push (@redrawList, 'room', $thisRoomObj);
}
}
# Redraw the affected rooms
$self->markObjs(@redrawList);
$self->doDraw();
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
}
# Handle a room draw/redraw/deletion
} elsif ($type eq 'room') {
if ($deleteFlag) {
# Unselect the room, if selected
$self->unselectObj(
$modelObj,
undef, # A room, not a room tag or room guild
TRUE, # No re-draw
);
# Also unselect the room tag and/or room guild, if either is selected
if (defined $modelObj->roomTag) {
$self->unselectObj(
$modelObj,
'room_tag',
TRUE, # No re-draw
);
}
if (defined $modelObj->roomGuild) {
$self->unselectObj(
$modelObj,
'room_guild',
TRUE, # No re-draw
);
}
}
if (! defined $modelObj->xPosBlocks) {
# No canvas objects to destroy
return undef;
}
# (The TRUE argument means to destroy canvas objects for the room, and also for any
# room echoes/room tags/room guilds/room text/checked directions)
$parchmentObj->deleteDrawnRoom($modelObj, TRUE);
# Handle a room tag deletion
} elsif ($type eq 'room_tag') {
if ($deleteFlag) {
# Unselect the room tag, if selected
$self->unselectObj(
$modelObj,
'room_tag',
TRUE, # No re-draw
);
}
if (! defined $modelObj->xPosBlocks) {
# No canvas objects to destroy
return undef;
}
$parchmentObj->deleteDrawnRoomTag($modelObj);
# Handle a room guild deletion
} elsif ($type eq 'room_guild') {
if ($deleteFlag) {
# Unselect the room guild, if selected
$self->unselectObj(
$modelObj,
'room_guild',
TRUE, # No re-draw
);
}
if (! defined $modelObj->xPosBlocks) {
# No canvas objects to destroy
return undef;
}
$parchmentObj->deleteDrawnRoomGuild($modelObj);
# Handle an exit deletion
} elsif ($type eq 'exit') {
# Unselect the exit, if selected
if ($deleteFlag) {
$self->unselectObj(
$modelObj,
undef, # An exit, not an exit tag
TRUE, # No re-draw
);
# Also unselect the exit tag, if it is selected
if (defined $modelObj->exitTag) {
$self->unselectObj(
$modelObj,
'exit_tag',
TRUE, # No re-draw
);
}
}
# (The TRUE argument means to destroy canvas objects for the exit, and also for any
# exit tags/ornaments)
$parchmentObj->deleteDrawnExit($modelObj, undef, TRUE);
# Handle an exit tag deletion
} elsif ($type eq 'exit_tag') {
if ($deleteFlag) {
# Unselect the exit tag, if selected
$self->unselectObj(
$modelObj,
'exit_tag',
TRUE, # No re-draw
);
}
$parchmentObj->deleteDrawnExitTag($modelObj);
# Handle a label deletion
} elsif ($type eq 'label') {
if ($deleteFlag) {
# Unselect the label, if selected
$self->unselectObj(
$modelObj,
undef, # A label, not a room tag or room guild
TRUE, # No re-draw
);
}
$parchmentObj->deleteDrawnLabel($modelObj);
# Handle a checked direction deletion
} elsif ($type eq 'checked_dir') {
# (Checked directions can't be selected)
if (! defined $modelObj->xPosBlocks) {
# No canvas objects to destroy
return undef;
}
$parchmentObj->deleteDrawnCheckedDir($modelObj);
# Handle a coloured block deletion
} elsif ($type eq 'square') {
# (Coloured squares can't be selected)
# For coloured squares, $modelObj is not a blessed reference, but a coordinate in the
# form 'x_y' (to delete canvas objects on all levels), or 'x_y_z' (to delete the
# canvas object on one level)
$parchmentObj->deleteColouredSquare($modelObj)
# Handle a coloured rectangle deletion
} elsif ($type eq 'rect') {
# (Coloured rectangles can't be selected)
# For coloured rectangles, $modelObj is not a blessed reference, but a key in the form
# 'object-number' (to delete canvas objects on all levels), or 'object-number_level'
# (to delete the canvas object on one level)
$parchmentObj->deleteColouredRect($modelObj)
} else {
# Unrecognised object type
return undef;
}
return 1;
}
sub startDrag {
# Called by $self->setupCanvasObjEvent and ->canvasEventHandler at the start of a drag
# operation
# Grabs the clicked canvas object and sets up IVs
#
# Expected arguments
# $type - What type of canvas object this is - 'room', 'room_tag', 'room_guild',
# 'exit', 'exit_tag' or 'label'
# $canvasObj - The canvas object on which the user clicked
# $modelObj - The GA::ModelObj::Room, GA::Obj::Exit or GA::Obj::MapLabel which
# corresponds to the canvas object $canvasObj
# $event - The mouse click event (a Gtk::Gdk::Event)
# $xPos, $yPos - The coordinates of the click on the canvas
#
# Return values
# 'undef' on improper arguments or if a dragging operation has already started
# 1 otherwise
my ($self, $type, $canvasObj, $modelObj, $event, $xPos, $yPos, $check) = @_;
# Local variables
my (
$exitMode, $obscuredFlag, $ornamentsFlag,
@canvasObjList, @fakeRoomList,
);
# Check for improper arguments
if (
! defined $type || ! defined $canvasObj || ! defined $modelObj || ! defined $event
|| ! defined $xPos || ! defined $yPos || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->startDrag', @_);
}
# Double-clicking on a canvas object can cause this function to be called twice; the second
# time, don't do anything
if ($self->dragFlag) {
return undef;
}
# If the tooltips are visible, hide them
$self->hideTooltips();
# Gtk3 can return fractional values for $xPos, $yPos. We definitely want only integers
$xPos = int($xPos);
$yPos = int($yPos);
# For dragged rooms/exits, we need an $exitMode value the same as would be used during a
# draw cycle
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $self->currentRegionmap->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# We also need values for $obscuredFlag and $ornamentsFlag, the same as would be used during
# a draw cycle
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$obscuredFlag = $self->currentRegionmap->obscuredExitFlag;
} else {
$obscuredFlag = $self->worldModelObj->obscuredExitFlag;
}
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$ornamentsFlag = $self->currentRegionmap->drawOrnamentsFlag;
} else {
$ornamentsFlag = $self->worldModelObj->drawOrnamentsFlag;
}
if ($type eq 'room') {
# If the room(s) have been drawn with an emphasised border, we need to re-draw them
# without emphasis - otherwise the extra square will be left behind on the canvas
# while the room is being dragged around
# Check that the room is selected. If not, we need to select it (which unselects any
# other selected rooms/labels)
if (
($self->selectedRoom && $self->selectedRoom ne $modelObj)
|| (
$self->selectedRoomHash
&& ! $self->ivExists('selectedRoomHash', $modelObj->number)
)
|| (! $self->selectedRoom && ! $self->selectedRoomHash)
) {
$self->setSelectedObj([$modelObj, 'room']);
}
# Temporarily set a few drawing cycle IVs, which allows the drawing functions to work as
# if we were in a drawing cycle (i.e. a call to $self->doDraw). They are reset by
# $self->stopDrag
$self->ivPoke('drawRegionmap', $self->currentRegionmap);
$self->ivPoke('drawParchment', $self->currentParchment);
$self->ivPoke(
'drawScheme',
$self->worldModelObj->getRegionScheme($self->currentRegionmap),
);
$self->prepareDraw($exitMode);
# If multiple rooms/labels are selected, they are all dragged alongside $canvasObj (as
# long as they're in the same region as $roomObj)
foreach my $roomObj ($self->compileSelectedRooms) {
my ($listRef, $thisCanvasObj, $fakeRoomObj);
# If the rooms are in the same region...
if ($roomObj->parent == $modelObj->parent) {
# Redraw the room without extra markings like interior text or an emphasised
# border
# (NB Calling $self->drawRoom here, instead of calling ->markObjs then ->doDraw
# as usual, is allowed. Because of the TRUE argument, ->drawRoom is expecting
# a call from this function)
$self->drawRoom($roomObj, $exitMode, $obscuredFlag, $ornamentsFlag, TRUE);
$listRef = $self->currentParchment->getDrawnRoom($roomObj);
$thisCanvasObj = $$listRef[0];
push (@canvasObjList, $thisCanvasObj);
if ($roomObj eq $modelObj) {
# This canvas object replaces the one that is actually being dragged/grabbed
$canvasObj = $thisCanvasObj;
}
# Draw a fake room at the same position, so that $modelObj's exits don't look
# odd
# (NB $self->drawFakeRoomBox is only called by this function, never by ->doDraw)
$fakeRoomObj = $self->drawFakeRoomBox($roomObj);
if ($fakeRoomObj) {
push (@fakeRoomList, $fakeRoomObj);
# Don't let the fake room object be obscured by room echos
$fakeRoomObj->raise();
}
# Raise the canvas object above others so that, while we're dragging it around,
# it doesn't disappear under exits (and so on)
$thisCanvasObj->raise();
}
}
foreach my $labelObj ($self->compileSelectedLabels) {
my ($listRef, $thisCanvasObj, $thisCanvasObj2);
# Drag both the label and its box (if it has one), as long as it's in the same
# region
if ($labelObj->region eq $self->currentRegionmap->name) {
$listRef = $self->currentParchment->getDrawnLabel($labelObj);
($thisCanvasObj, $thisCanvasObj2) = @$listRef;
if ($thisCanvasObj2) {
push (@canvasObjList, $thisCanvasObj2);
$thisCanvasObj2->raise();
}
push (@canvasObjList, $thisCanvasObj);
$thisCanvasObj->raise();
}
}
} elsif ($type eq 'exit') {
my ($twinExitObj, $bendNum, $bendIndex, $twinBendNum, $twinBendIndex);
if ($modelObj->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow('exitModelHash', $modelObj->twinExit);
}
# Temporarily set a few drawing cycle IVs, which allows the drawing functions to work as
# if we were in a drawing cycle (i.e. a call to $self->doDraw). They are reset by
# $self->stopDrag
$self->ivPoke('drawRegionmap', $self->currentRegionmap);
$self->ivPoke('drawParchment', $self->currentParchment);
$self->ivPoke(
'drawScheme',
$self->worldModelObj->getRegionScheme($self->currentRegionmap),
);
$self->prepareDraw($exitMode);
# See if the click was near a bend
$bendNum = $self->findExitBend($modelObj, $xPos, $yPos);
if (defined $bendNum) {
# Set IVs to monitor the bend's position, relative to its position right now
$self->ivPoke('dragBendNum', $bendNum);
# (The first bend, $bendNum = 0, occupies the first two items in ->bendOffsetList)
$bendIndex = $bendNum * 2;
$self->ivPoke('dragBendInitXPos', $modelObj->ivIndex('bendOffsetList', $bendIndex));
$self->ivPoke(
'dragBendInitYPos',
$modelObj->ivIndex('bendOffsetList', ($bendIndex + 1)),
);
$self->ivPoke('dragExitDrawMode', $exitMode);
$self->ivPoke('dragExitOrnamentsFlag', $ornamentsFlag);
# If there's a twin exit, set IVs for the corresponding bend in the twin
if ($twinExitObj) {
$twinBendNum = ((scalar $twinExitObj->bendOffsetList / 2) - $bendNum - 1);
$self->ivPoke('dragBendTwinNum', $twinBendNum);
# (The 2nd bend, $bendNum = 1, occupies the 2nd two items in ->bendOffsetList)
$twinBendIndex = $twinBendNum * 2;
$self->ivPoke(
'dragBendTwinInitXPos',
$twinExitObj->ivIndex('bendOffsetList', $twinBendIndex),
);
$self->ivPoke(
'dragBendTwinInitYPos',
$twinExitObj->ivIndex('bendOffsetList', ($twinBendIndex + 1)),
);
}
} else {
# Destroy the existing canvas object
$self->deleteCanvasObj(
'exit',
$modelObj,
$self->currentRegionmap,
$self->currentParchment,
);
# The canvas objects for the exit may have been drawn associated with $exitObj, or
# with its twin exit (if any); make sure those canvas objects are destroyed, too
# (except for normal broken exits, region exits, impassable exits and mystery
# exits)
if (
$twinExitObj
&& (
(! $twinExitObj->brokenFlag || $twinExitObj->bentFlag)
&& ! $twinExitObj->regionFlag
&& $twinExitObj->exitOrnament ne 'impass'
&& $twinExitObj->exitOrnament ne 'mystery'
)
) {
$self->deleteCanvasObj(
'exit',
$twinExitObj,
$self->currentRegionmap,
$self->currentParchment,
);
}
# Draw a draggable exit, starting from $exitObj's normal start position, and ending
# at the position of the mouse click
$canvasObj = $self->drawDraggableExit($modelObj, $xPos, $yPos);
}
push (@canvasObjList, $canvasObj);
} elsif ($type eq 'label') {
my $listRef;
# If the label has a box, the user might have clicked on either the label or the box.
# In either case, both objects need to be dragged
$listRef = $self->currentParchment->getDrawnLabel($modelObj);
foreach my $thisCanvasObj (reverse @$listRef) {
push (@canvasObjList, $thisCanvasObj);
$thisCanvasObj->raise(); # Text last, raised above box
}
# The canvas object to grab is always the label text, not the box (as $self->stopDrag
# works out the distance using the label text)
$canvasObj = $$listRef[0];
} else {
# For room tags, room guilds and exit tags, just raise the canvas object above others
push (@canvasObjList, $canvasObj);
$canvasObj->raise();
}
# Grab the dragged canvas object
$canvasObj->get_canvas->pointer_grab(
$canvasObj,
[qw/pointer-motion-mask button-release-mask/],
Gtk3::Gdk::Cursor->new('fleur'),
$event->time,
);
# Mark the drag as started, and update IVs (the IVs for bent exits have already been set)
$self->ivPoke('dragFlag', TRUE);
$self->ivPoke('dragCanvasObj', $canvasObj);
$self->ivPoke('dragCanvasObjList', @canvasObjList);
$self->ivPoke('dragModelObj', $modelObj);
$self->ivPoke('dragModelObjType', $type);
$self->ivPoke('dragInitXPos', $xPos);
$self->ivPoke('dragInitYPos', $yPos);
$self->ivPoke('dragCurrentXPos', $xPos);
$self->ivPoke('dragCurrentYPos', $yPos);
$self->ivPoke('dragFakeRoomList', @fakeRoomList);
return 1;
}
sub continueDrag {
# Called by $self->setupCanvasObjEvent in the middle of a drag operation
# Redraws canvas object(s) on the canvas and updates IVs
#
# Expected arguments
# $event - The mouse click event (a Gtk::Gdk::Event)
# $xPos, $yPos - The coordinates of the mouse above the canvas
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $event, $xPos, $yPos, $check) = @_;
# Local variables
my ($moveX, $moveY, $twinExitObj, $listRef, $canvasObj);
# Check for improper arguments
if (! defined $event || ! defined $xPos || ! defined $yPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->continueDrag', @_);
}
# Don't do anything if an earlier call to this function hasn't been completed (happens quite
# a lot if the user is dragging objects around rapidly, and it messes up the correct value
# of $self->dragCurrentXPos and ->dragCurrentYPos)
if ($self->dragContinueFlag) {
return undef;
} else {
$self->ivPoke('dragContinueFlag', TRUE);
}
# Gtk3 can return fractional values for $xPos, $yPos. We definitely want only integers
$xPos = int($xPos);
$yPos = int($yPos);
# For everything except exits, move the canvas object(s)
if ($self->dragModelObjType ne 'exit') {
$moveX = $xPos - $self->dragCurrentXPos;
$moveY = $yPos - $self->dragCurrentYPos;
foreach my $canvasObj ($self->dragCanvasObjList) {
$canvasObj->translate($moveX, $moveY);
}
} else {
# Ungrab the exit's canvas object
$self->dragCanvasObj->get_canvas->pointer_ungrab($self->dragCanvasObj, $event->time);
# If dragging an exit bend...
if (defined $self->dragBendNum) {
# Update the exit's list of bend positions
$self->worldModelObj->adjustExitBend(
$self->dragModelObj,
$self->dragBendNum,
$self->dragBendInitXPos + ($xPos - $self->dragInitXPos),
$self->dragBendInitYPos + ($yPos - $self->dragInitYPos),
);
# Adjust the corresponding bend in the twin exit, if there is one
if (defined $self->dragBendTwinNum) {
$twinExitObj = $self->worldModelObj->ivShow(
'exitModelHash',
$self->dragModelObj->twinExit,
);
$self->worldModelObj->adjustExitBend(
$twinExitObj,
$self->dragBendTwinNum,
$self->dragBendTwinInitXPos + ($xPos - $self->dragInitXPos),
$self->dragBendTwinInitYPos + ($yPos - $self->dragInitYPos),
);
}
# Destroy the bending exit's existing canvas objects
$self->deleteCanvasObj(
'exit',
$self->dragModelObj,
$self->currentRegionmap,
$self->currentParchment,
);
# Redraw the bending exit, with the dragged bend in its new position
$self->drawBentExit(
$self->worldModelObj->ivShow('modelHash', $self->dragModelObj->parent),
$self->dragModelObj,
$self->dragExitDrawMode,
$self->dragExitOrnamentsFlag,
$twinExitObj,
);
if ($twinExitObj) {
$self->deleteCanvasObj(
'exit',
$twinExitObj,
$self->currentRegionmap,
$self->currentParchment,
);
}
# Get the new canvas object to grab. Since the bending exit consists of several
# canvas objects, use the first one
$listRef = $self->currentParchment->getDrawnExit($self->dragModelObj);
$canvasObj = $$listRef[0];
# If dragging a draggable exit...
} else {
# Destroy the old canvas object
$self->dragCanvasObj->remove();
# Replace it with a new one draggable exit at the current mouse position
$canvasObj = $self->drawDraggableExit($self->dragModelObj, $xPos, $yPos);
}
# Grab the new canvas object
$canvasObj->get_canvas->pointer_grab(
$canvasObj,
[qw/pointer-motion-mask button-release-mask/],
Gtk3::Gdk::Cursor->new('fleur'),
$event->time,
);
$self->ivPoke('dragCanvasObj', $canvasObj);
}
# Update IVs
$self->ivPoke('dragCurrentXPos', $xPos);
$self->ivPoke('dragCurrentYPos', $yPos);
$self->ivPoke('dragContinueFlag', FALSE);
return 1;
}
sub stopDrag {
# Called by $self->setupCanvasObjEvent at the end of a drag operation
#
# Expected arguments
# $event - The mouse click event (a Gtk::Gdk::Event)
# $xPos, $yPos - The coordinates of the click on the canvas
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $event, $xPos, $yPos, $check) = @_;
# Local variables
my @drawList;
# Check for improper arguments
if (! defined $event || ! defined $xPos || ! defined $yPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->stopDrag', @_);
}
# Gtk3 can return fractional values for $xPos, $yPos. We definitely want only integers
$xPos = int($xPos);
$yPos = int($yPos);
# Ungrab the grabbed canvas object
$self->dragCanvasObj->get_canvas->pointer_ungrab($self->dragCanvasObj, $event->time);
# Mark the drag operation as finished
$self->ivPoke('dragFlag', FALSE);
# If rooms have been dragged, there may be some entries in ->drawCycleExitHash. Empty it,
# allowing the exits in all affected rooms to be redrawn
$self->ivEmpty('drawCycleExitHash');
# Respond to the end of the drag operation
if ($self->dragModelObjType eq 'room') {
my (
$newXPos, $newYPos, $adjustXPos, $adjustYPos, $occupyRoomNum, $occupyRoomObj,
$failFlag,
%roomHash, %labelHash,
);
# Destroy any fake room canvas objects
foreach my $fakeRoomObj ($self->dragFakeRoomList) {
$fakeRoomObj->remove();
}
# Destroy the moving room/label canvas objects, as we're not redrawing the whole region
foreach my $moveRoomObj ($self->dragCanvasObjList) {
$moveRoomObj->remove();
}
# Calculate the grid coordinates of the dragged room's new gridblock
$newXPos = int ($self->dragCurrentXPos / $self->currentRegionmap->blockWidthPixels);
$newYPos = int ($self->dragCurrentYPos / $self->currentRegionmap->blockHeightPixels);
# Calculate the distance travelled (in blocks)
$adjustXPos = $newXPos
- int ($self->dragInitXPos / $self->currentRegionmap->blockWidthPixels);
$adjustYPos = $newYPos
- int ($self->dragInitYPos / $self->currentRegionmap->blockHeightPixels);
# Fetch the room occupying that gridblock (if any)
$occupyRoomNum = $self->currentRegionmap->fetchRoom(
$newXPos,
$newYPos,
$self->currentRegionmap->currentLevel,
);
if ($occupyRoomNum) {
$occupyRoomObj = $self->worldModelObj->ivShow('modelHash', $occupyRoomNum);
}
# If the grabbed room hasn't been dragged to a new gridblock, don't do anything
if (! $adjustXPos && ! $adjustYPos) {
# Just redraw the dragged room(s)/label(s) at their original position
foreach my $roomObj ($self->compileSelectedRooms) {
push (@drawList, 'room', $roomObj);
}
foreach my $labelObj ($self->compileSelectedLabels) {
push (@drawList, 'label', $labelObj);
}
$self->markObjs(@drawList);
$self->doDraw();
# If the dragged room is the current room, and the automapper object is set up to merge
# rooms, and one of its matching rooms is the one occupying the dragged room's new
# gridblock
} elsif (
$self->mapObj->currentRoom
&& $self->mapObj->currentRoom eq $self->dragModelObj
&& $occupyRoomObj
&& defined $self->mapObj->ivFind('currentMatchList', $occupyRoomObj)
) {
# The TRUE argument means 'don't prompt for confirmation', as the map looks very
# odd at the moment with only room boxes, exists, room interior info and so on
# visible
if (! $self->doMerge($self->dragModelObj, $occupyRoomObj, TRUE)) {
# Merge/move operation failed, so redraw the selected rooms/labels at their
# original positions
foreach my $roomObj ($self->compileSelectedRooms) {
push (@drawList, 'room', $roomObj);
}
foreach my $labelObj ($self->compileSelectedLabels) {
push (@drawList, 'label', $labelObj);
}
$self->markObjs(@drawList);
$self->doDraw();
}
# If a single room and no labels are selected...
} elsif ($self->selectedRoom && ! $self->selectedLabel && ! $self->selectedLabelHash) {
# Check that the new gridblock isn't occupied
if ($occupyRoomNum) {
# The room has been dragged to an occupied gridblock. Don't move the room, just
# redraw it at its original position
$self->markObjs('room', $self->dragModelObj);
$self->doDraw();
} else {
# Move the (selected) room to its new location
$self->moveSelectedObjs(
($newXPos - $self->dragModelObj->xPosBlocks),
($newYPos - $self->dragModelObj->yPosBlocks),
0, # Room doesn't change level
);
# Select the room
$self->setSelectedObj(
[$self->dragModelObj, 'room'],
FALSE, # Select this object; unselect all other objects
);
}
# Multiple rooms and/or labels are selected; move all of them the same distance
} else {
# Start by creating combined hashes, merging two IVs into one hash
%roomHash = $self->selectedRoomHash;
if ($self->selectedRoom) {
$roomHash{$self->seletedRoom->number} = $self->selectedRoom;
}
%labelHash = $self->selectedLabelHash;
if ($self->selectedLabel) {
$labelHash{$self->selectedLabel->id} = $self->selectedLabel;
}
# Check every room to make sure it's been dragged to a new, unoccupied gridblock
OUTER: foreach my $roomObj (values %roomHash) {
my $existRoomNum = $self->currentRegionmap->fetchRoom(
$roomObj->xPosBlocks + $adjustXPos,
$roomObj->yPosBlocks + $adjustYPos,
$self->currentRegionmap->currentLevel,
);
if (defined $existRoomNum && ! exists $roomHash{$existRoomNum}) {
# At least one of the gridblocks is occupied by a room that's not going
# to be moved along with all the others
$failFlag = TRUE;
last OUTER;
}
}
if ($failFlag) {
# One or more of the selected rooms have been dragged to a gridblock occupied by
# a room that isn't one of those being moved
# Don't move anything, just redraw the selected rooms/labels at their original
# positions
foreach my $roomObj ($self->compileSelectedRooms) {
push (@drawList, 'room', $roomObj);
}
foreach my $labelObj ($self->compileSelectedLabels) {
push (@drawList, 'label', $labelObj);
}
$self->markObjs(@drawList);
$self->doDraw();
} else {
# Move all selected rooms to their new locations
$self->worldModelObj->moveRoomsLabels(
$self->session,
TRUE, # Update Automapper windows now
$self->currentRegionmap, # Move from this region...
$self->currentRegionmap, # ...to this one...
$adjustXPos, # ...using this vector
$adjustYPos,
0, # No vertical displacement
\%roomHash,
\%labelHash,
);
}
}
} elsif ($self->dragModelObjType eq 'exit') {
my $destRoomObj;
# Don't need to do anything at the end of a drag operation, if we're dragging an exit
# bend
if (! defined $self->dragBendNum) {
# Destroy the draggable exit
$self->dragCanvasObj->remove();
# Work out whether the end of the draggable exit (the coordinates are $xPos, $yPos)
# was over a room that wasn't the exit's parent room or its existing destination
# room
$destRoomObj = $self->findMouseOverRoom($xPos, $yPos, $self->dragModelObj);
if (! $destRoomObj) {
# No connection to make. Redraw the original exit, at its original size and
# position
$self->markObjs('exit', $self->dragModelObj);
$self->doDraw();
} else {
# Connect the exit to the room (it's in the same region as the exit's parent
# room, so it's potentially a broken exit, and definitely not a region exit)
$self->connectExitToRoom($destRoomObj, 'broken', $self->dragModelObj);
}
}
} else {
my ($newXPos, $newYPos);
# Work out the difference between the new position and the original position
$newXPos = int ($self->dragCurrentXPos - $self->dragInitXPos);
$newYPos = int ($self->dragCurrentYPos - $self->dragInitYPos);
# Move the object and instruct the world model to update its Automapper windows
$self->worldModelObj->moveOtherObjs(
TRUE, # Update Automapper windows immediately
$self->dragModelObjType,
$self->dragModelObj,
$newXPos,
$newYPos,
);
}
# Reset other IVs (->dragFlag was set above)
$self->ivUndef('dragCanvasObj');
$self->ivEmpty('dragCanvasObjList');
$self->ivUndef('dragModelObj');
$self->ivUndef('dragModelObjType');
$self->ivUndef('dragInitXPos');
$self->ivUndef('dragInitYPos');
$self->ivUndef('dragCurrentXPos');
$self->ivUndef('dragCurrentYPos');
$self->ivEmpty('dragFakeRoomList');
$self->ivUndef('dragBendNum');
$self->ivUndef('dragBendInitXPos');
$self->ivUndef('dragBendInitYPos');
$self->ivUndef('dragBendTwinNum');
$self->ivUndef('dragBendTwinInitXPos');
$self->ivUndef('dragBendTwinInitYPos');
$self->ivUndef('dragExitDrawMode');
$self->ivUndef('dragExitOrnamentsFlag');
# Also reset the drawing cycle IVs set by $self->startDrag
$self->tidyUpDraw();
return 1;
}
sub startSelectBox {
# Called by $self->canvasEventHandler
# When the user holds down their left mouse button on an empty area of the map, and then
# moves their mouse, we draw a selection box. When the user releases the mouse button,
# all rooms and labels inside the box are selected
# When this function is called, the user has merely left-clicked the empty area of the map.
# This function initialises IVs. We don't actually draw the selection box until the user
# moves their mouse while holding down the left mouse button
#
# Expected arguments
# $xPos, $yPos - The coordinates of the click on the canvas
#
# Return values
# 'undef' on improper arguments or if a selection box operation has already started
# 1 otherwise
my ($self, $xPos, $yPos, $check) = @_;
# Check for improper arguments
if (! defined $xPos || ! defined $yPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->startSelectBox', @_);
}
# Double-clicking on a canvas object can cause this function to be called twice; the second
# time, don't do anything
if ($self->selectBoxFlag) {
return undef;
}
# If the tooltips are visible, hide them
$self->hideTooltips();
# Initialise IVs
$self->ivPoke('selectBoxFlag', TRUE);
$self->ivUndef('selectBoxCanvasObj');
$self->ivPoke('selectBoxInitXPos', $xPos);
$self->ivPoke('selectBoxInitYPos', $yPos);
$self->ivPoke('selectBoxCurrentXPos', $xPos);
$self->ivPoke('selectBoxCurrentYPos', $yPos);
# Temporarily set a few drawing cycle IVs, which allows the drawing functions to work as if
# we were in a drawing cycle (i.e. a call to $self->doDraw). They are reset by
# $self->stopSelectBox
$self->ivPoke(
'selectDrawScheme',
$self->worldModelObj->getRegionScheme($self->currentRegionmap),
);
return 1;
}
sub continueSelectBox {
# Called by $self->setupCanvasEvent
# Draws (or redraws) the selection box, after an earlier call to ->startSelectBox started
# the operation
#
# Expected arguments
# $event - The Gtk3::Gdk::Event that caused the signal
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $event, $check) = @_;
# Local variables
my ($canvasWidget, $x1, $y1, $x2, $y2, $canvasObj);
# Check for improper arguments
if (! defined $event || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->continueSelectBox', @_);
}
# Get the canvas widget for the current level
$canvasWidget = $self->currentParchment->ivShow(
'canvasWidgetHash',
$self->currentRegionmap->currentLevel,
);
# Deleting the existing canvas object (if one has already been drawn)
if ($self->selectBoxCanvasObj) {
# No need to call $self->deleteCanvasObj - the canvas object we're drawing doesn't
# represent anything in the world model
$self->selectBoxCanvasObj->remove();
}
# Set the selection box's coordinates
$x1 = $self->selectBoxInitXPos;
$y1 = $self->selectBoxInitYPos;
($x2, $y2) = (int($event->x), int($event->y));
# If the user has somehow moved the mouse to the exact original location, don't draw a new
# canvas object at all (but the operation continues until the user releases the mouse
# button)
if ($x1 == $x2 && $y1 == $y2) {
$self->ivUndef('selectBoxCanvasObj');
} else {
# Swap values so that ($x1, $y1) represents the top-left corner of the selection box,
# and ($x2, $y2) represents the bottom-right corner
if ($x1 > $x2) {
($x1, $x2) = ($x2, $x1);
}
if ($y1 > $y2) {
($y1, $y2) = ($y2, $y1);
}
# Draw the new canvas object
$canvasObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $x1,
'y' => $y1,
'width' => $x2 - $x1 + 1,
'height' => $y2 - $y1 + 1,
# 'line-width' => 2,
'stroke-color' => $self->selectDrawScheme->selectBoxColour,
# 'fill-color' => $self->selectDrawScheme->selectBoxColour,
);
# Move it above everything else
$canvasObj->raise();
$self->ivPoke('selectBoxCanvasObj', $canvasObj);
}
# Update remaining IVs
$self->ivPoke('selectBoxCurrentXPos', int($event->x));
$self->ivPoke('selectBoxCurrentYPos', int($event->y));
return 1;
}
sub stopSelectBox {
# Called by $self->canvasEventHandler
# Terminates the selection box operation. Destroys the canvas object, updates IVs and calls
# $self->selectAllInBox to handle selecting any objects within the selection box
#
# Expected arguments
# $event - The Gtk3::Gdk::Event that caused the signal
# $xPos, $yPos - The coordinates of the release-click on the canvas
#
# Return values
# 'undef' on improper arguments or if no selection box has been drawn yet
# 1 otherwise
my ($self, $event, $xPos, $yPos, $check) = @_;
# Local variables
my ($x1, $y1, $x2, $y2);
# Check for improper arguments
if (! defined $event || ! defined $xPos || ! defined $yPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->stopSelectBox', @_);
}
# If the user hasn't actually moved their mouse while the left mouse button was held down,
# then no selection box was drawn. Just unselect all selected objects
if (! $self->selectBoxCanvasObj) {
$self->setSelectedObj();
} else {
$self->selectBoxCanvasObj->remove();
$x1 = $self->selectBoxInitXPos;
$y1 = $self->selectBoxInitYPos;
$x2 = $self->selectBoxCurrentXPos;
$y2 = $self->selectBoxCurrentYPos;
# Again, swap values so that ($x1, $y1) represents the top-left corner of the selection
# box, and ($x2, $y2) represents the bottom-right corner
if ($x1 > $x2) {
($x1, $x2) = ($x2, $x1);
}
if ($y1 > $y2) {
($y1, $y2) = ($y2, $y1);
}
# Select everything within that zone
$self->selectAllInBox($event, $x1, $y1, $x2, $y2);
}
# In either case, must reset IVs
$self->ivPoke('selectBoxFlag', FALSE);
$self->ivUndef('selectBoxCanvasObj');
$self->ivUndef('selectBoxInitXPos');
$self->ivUndef('selectBoxInitYPos');
$self->ivUndef('selectBoxCurrentXPos');
$self->ivUndef('selectBoxCurrentYPos');
$self->ivUndef('selectDrawScheme');
return 1;
}
sub chooseClickedExit {
# Called by $self->startDrag when the user starts to drag an exit, and by
# ->canvasObjEventHandler clicks an unselected exit
# Selects which exit to use - the exit whose canvas object was clicked, or its twin exit -
# and returns the exit
#
# Expected arguments
# $exitObj - The exit object whose canvas object was clicked
# $xPos, $yPos - The coordinates of the mouse click on the canvas object
#
# Return values
# 'undef' on improper arguments
# Otherwise, returns either $exitObj or its twin exit object
my ($self, $exitObj, $xPos, $yPos, $check) = @_;
# Local variables
my ($twinExitObj, $distance, $twinDistance);
# Check for improper arguments
if (! defined $exitObj || ! defined $xPos || ! defined $yPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->chooseClickedExit', @_);
}
if ($exitObj->twinExit) {
# If the exit is a region exit, or a normal (not bent) broken exit, then there is no
# doubt that the clicked exit (not its twin) is the one to drag/select
if (
$exitObj->regionFlag
|| ($exitObj->brokenFlag && ! $exitObj->bentFlag)
) {
return $exitObj;
}
# User clicked on a two-way exit, so we need to decide which exit to drag/select
$twinExitObj = $self->worldModelObj->ivShow('exitModelHash', $exitObj->twinExit);
# Find the distance, in pixels, between the click and the centre of the exit's parent
# room
$distance = $self->findDistanceToRoom($exitObj, $xPos, $yPos);
# Find the distance, in pixels, between the click and the centre of the twin exit's
# parent room
$twinDistance = $self->findDistanceToRoom($twinExitObj, $xPos, $yPos);
# If the distance to $exitObj's parent room is shorter, then use the twin exit as the
# clicked exit (otherwise, use $exitObj as the clicked exit)
if ($distance < $twinDistance) {
return $twinExitObj;
}
}
# Otherwise, use $exitObj
return $exitObj;
}
sub findDistanceToRoom {
# Called by $self->chooseClickedExit
# When the user clicks on an exit, finds the distance between the exit and the centre of the
# parent room (in pixels)
#
# Expected arguments
# $exitObj - The exit object whose canvas object was clicked
# $xPos, $yPos - The coordinates of the mouse click on the canvas object
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $exitObj, $xPos, $yPos, $check) = @_;
# Local variables
my ($roomObj, $roomXPos, $roomYPos, $lengthX, $lengthY);
# Check for improper arguments
if (! defined $exitObj || ! defined $xPos || ! defined $yPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findDistanceToRoom', @_);
}
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
$roomXPos = ($roomObj->xPosBlocks * $self->currentRegionmap->blockWidthPixels)
+ int($self->currentRegionmap->blockWidthPixels / 2);
$roomYPos = ($roomObj->yPosBlocks * $self->currentRegionmap->blockHeightPixels)
+ int($self->currentRegionmap->blockHeightPixels / 2);
$lengthX = abs($roomXPos - $xPos);
$lengthY = abs($roomYPos - $yPos);
return (sqrt(($lengthX ** 2) + ($lengthY ** 2)));
}
sub findSelectedRoomArea {
# Called by $self->canvasObjEventHandler
# Finds the smallest area on the current level of the grid which contains all the selected
# rooms on this level
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments, or if there are no selected rooms on the current
# level
# Otherwise, returns a list containing two pairs of grid coordinates - the top-left and
# bottom-right gridblock of the currently selected area (which might be the same
# block, if there's only one selected room). The list is in the form
# ($startX, $startY, $stopX, $stopY)
my ($self, $check) = @_;
# Local variables
my (
$startX, $startY, $stopX, $stopY, $count,
@emptyList,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findSelectedRoomArea', @_);
return @emptyList;
}
if ($self->selectedRoom) {
# There is only one selected room. Is it in the current region's current level?
if (
$self->selectedRoom->parent == $self->currentRegionmap->number
&& $self->selectedRoom->zPosBlocks == $self->currentRegionmap->currentLevel
) {
# It's on the current level
$startX = $self->selectedRoom->xPosBlocks;
$startY = $self->selectedRoom->yPosBlocks;
$stopX = $self->selectedRoom->xPosBlocks;
$stopY = $self->selectedRoom->yPosBlocks;
} else {
return @emptyList;
}
} elsif ($self->selectedRoomHash) {
# Check every room in ->selectedRoomHash, and expand the borders of the selected area as
# we go
$count = 0;
foreach my $roomObj ($self->ivValues('selectedRoomHash')) {
if (
$roomObj->parent == $self->currentRegionmap->number
&& $roomObj->zPosBlocks == $self->currentRegionmap->currentLevel
) {
$count++;
if ($count == 1) {
# This is the first room processed
$startX = $roomObj->xPosBlocks;
$startY = $roomObj->yPosBlocks;
$stopX = $roomObj->xPosBlocks;
$stopY = $roomObj->yPosBlocks;
} else {
if ($roomObj->xPosBlocks < $startX) {
$startX = $roomObj->xPosBlocks;
} elsif ($roomObj->xPosBlocks > $stopX) {
$stopX = $roomObj->xPosBlocks;
}
if ($roomObj->yPosBlocks < $startY) {
$startY = $roomObj->yPosBlocks;
} elsif ($roomObj->yPosBlocks > $stopY) {
$stopY = $roomObj->yPosBlocks;
}
}
}
}
if (! $count) {
# No selected rooms in the current region's current level
return @emptyList;
}
} else {
# No selected rooms at all
return @emptyList;
}
# Return the coordinates of opposite corners of the area
return ($startX, $startY, $stopX, $stopY);
}
sub checkRoomIsSelected {
# Called by $self->canvasObjEventHandler
# Checks, as quickly as possible, whether a room is selected, or not
#
# Expected arguments
# $roomObj - The room to check
#
# Return values
# 'undef' on improper arguments or if the room is not selected
# 1 if the room is selected
my ($self, $roomObj, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->checkRoomIsSelected', @_);
}
if ($self->selectedRoom && $self->selectedRoom eq $roomObj) {
return 1;
} elsif ( ! $self->selectedRoomHash) {
return undef;
} else {
if ($self->ivExists('selectedRoomHash', $roomObj->number)) {
return 1;
} else {
return undef;
}
}
}
sub selectRoomsInArea {
# Called by $self->canvasObjEventHandler
# Selects all the rooms on the current level of the current regionmap, within a specified
# area, and unselects all other rooms (on all levels)
# (Also unselects any selected room tags, room guilds, exits, exit tags or labels)
#
# Expected arguments
# $startX, $startY, $stopX, $stopY
# - Grid coordinates of the top-left and bottom-right of the area, in which all rooms
# should be selected
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $startX, $startY, $stopX, $stopY, $check) = @_;
# Local variables
my (
$count, $lastRoomObj,
@selectedRoomlist, @selectedRoomTagList, @selectedRoomGuildList, @selectedExitList,
@selectedExitTagList, @selectedLabelList, @redrawList,
%currentHash, %newHash, %selectedRoomHash,
);
# Check for improper arguments
if (
! defined $startX || ! defined $startY || ! defined $stopX || ! defined $stopY
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectRoomsInArea', @_);
}
# The regionmap's ->gridRoomHash contains all the rooms in the current region. Import the
# hash
%currentHash = $self->currentRegionmap->gridRoomHash;
# Compile a new hash, in the same format as $self->selectedRoomHash, containing only those
# rooms in the selected area (and on the current level)
$count = 0;
foreach my $position (keys %currentHash) {
my ($number, $roomObj);
$number = $currentHash{$position};
$roomObj = $self->worldModelObj->ivShow('modelHash', $number);
if (
$roomObj
&& $roomObj->zPosBlocks == $self->currentRegionmap->currentLevel
&& $roomObj->xPosBlocks >= $startX
&& $roomObj->xPosBlocks <= $stopX
&& $roomObj->yPosBlocks >= $startY
&& $roomObj->yPosBlocks <= $stopY
) {
# Mark this room for selection
$newHash{$number} = $roomObj;
$count++;
$lastRoomObj = $roomObj;
}
}
# Compile a list of currently selected rooms, exits, room tags, room guilds and labels
@selectedRoomlist = $self->compileSelectedRooms();
@selectedRoomTagList = $self->compileSelectedRoomTags();
@selectedRoomGuildList = $self->compileSelectedRoomGuilds();
@selectedExitList = $self->compileSelectedExits();
@selectedExitTagList = $self->compileSelectedExitTags();
@selectedLabelList = $self->compileSelectedLabels();
# Transfer the list of currently selected rooms into a hash, so that we can compare them
# with %newHash
foreach my $ref (@selectedRoomlist) {
$selectedRoomHash{$ref} = $ref;
}
# Check that the same room doesn't exist in %newHash and %selectedRoomHash. If so, delete
# the entry in %selectedRoomHash
foreach my $obj (values %newHash) {
if (exists $selectedRoomHash{$obj}) {
delete $selectedRoomHash{$obj};
}
}
# Set the IVs that contain all selected objects
if ($count == 1) {
$self->ivPoke('selectedRoom', $lastRoomObj);
$self->ivEmpty('selectedRoomHash');
} else {
$self->ivUndef('selectedRoom');
$self->ivPoke('selectedRoomHash', %newHash);
}
# Make sure there are no room tags, room guilds, exits, exit tags or labels selected
$self->ivUndef('selectedRoomTag');
$self->ivEmpty('selectedRoomTagHash');
$self->ivUndef('selectedRoomGuild');
$self->ivEmpty('selectedRoomGuildHash');
$self->ivUndef('selectedExit');
$self->ivEmpty('selectedExitHash');
$self->ivUndef('selectedExitTag');
$self->ivEmpty('selectedExitTagHash');
$self->ivUndef('selectedLabel');
$self->ivEmpty('selectedLabelHash');
# Finally, re-draw all objects that have either been selected or unselected. Compile a list
# to send to ->markObjs, in the form (type, object, type, object, ...)
foreach my $obj (values %newHash) {
push (@redrawList, 'room', $obj);
}
foreach my $obj (values %selectedRoomHash) {
push (@redrawList, 'room', $obj);
}
foreach my $obj (@selectedRoomTagList) {
push (@redrawList, 'room_tag', $obj);
}
foreach my $obj (@selectedRoomGuildList) {
push (@redrawList, 'room_guild', $obj);
}
foreach my $obj (@selectedExitList) {
push (@redrawList, 'exit', $obj);
}
foreach my $obj (@selectedExitTagList) {
push (@redrawList, 'exit_tag', $obj);
}
foreach my $obj (@selectedLabelList) {
push (@redrawList, 'label', $obj);
}
# Actually redraw the affected objects
$self->markObjs(@redrawList);
$self->doDraw();
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# Operation complete
return 1;
}
sub selectAllInBox {
# Called by $self->stopSelectBox
# After the user has specified an area of the map, get a list of rooms and/or labels within
# that area, and select them
#
# Expected arguments
# $event - The Gtk3::Gdk::Event that caused the signal
# $x1, $y1 - Canvas coordinates of the top-left corner of the selection box
# $x2, $y2 - Coordinates of the bottom-right corner
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $event, $x1, $y1, $x2, $y2, $check) = @_;
# Local variables
my (
$level, $coord, $xBlocks1, $yBlocks1, $xBlocks2, $yBlocks2, $exitMode, $borderX1,
$borderY1, $borderX2, $borderY2,
@selectList,
%roomHash,
);
# Check for improper arguments
if (
! defined $event || ! defined $x1 || ! defined $y1 || ! defined $x2 || ! defined $y2
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectAllInBox', @_);
}
# Import the world model's room hash (for speed)
%roomHash = $self->worldModelObj->roomModelHash;
# Import the current level (for speed)
$level = $self->currentRegionmap->currentLevel;
# Convert canvas (pixel) coordinates to gridblock coordinates
($xBlocks1, $yBlocks1) = $self->findGridBlock($x1, $y1, $self->currentRegionmap);
($xBlocks2, $yBlocks2) = $self->findGridBlock($x2, $y2, $self->currentRegionmap);
# Get the position of a room's border drawn within its gridblock
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $self->currentRegionmap->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# The coordinates of the pixel at the top-left corner of the room box
if ($exitMode eq 'no_exit') {
# Draw exit mode 'no_exit': The room takes up the whole gridblock
$borderX1 = 0;
$borderY1 = 0;
$borderX2 = $self->currentRegionmap->blockWidthPixels - 1;
$borderY2 = $self->currentRegionmap->blockHeightPixels - 1;
} else {
# Draw exit modes 'simple_exit'/'complex_exit': The room takes up the central part of
# the gridblock
$borderX1 = int(
(
$self->currentRegionmap->blockWidthPixels
- $self->currentRegionmap->roomWidthPixels
) / 2
);
$borderY1 = int(
(
$self->currentRegionmap->blockHeightPixels
- $self->currentRegionmap->roomHeightPixels
) / 2
);
$borderX2 = $borderX1 + $self->currentRegionmap->roomWidthPixels - 1;
$borderY2 = $borderX1 + $self->currentRegionmap->roomHeightPixels - 1;
}
if ($xBlocks1 == $xBlocks2 && $yBlocks1 == $yBlocks2) {
# Special case - if it's only one block, then don't check every room in the region
$coord = $xBlocks1 . '_' . $yBlocks1 . '_' . $level;
if ($self->currentRegionmap->ivExists('gridRoomHash', $coord)) {
push (
@selectList,
$self->worldModelObj->ivShow(
'modelHash',
$self->currentRegionmap->ivShow('gridRoomHash', $coord),
),
'room',
);
}
} else {
# Find of rooms that are wholly or partially within the selection box
foreach my $roomNum ($self->currentRegionmap->ivValues('gridRoomHash')) {
my ($roomObj, $roomXBlocks, $roomYBlocks);
$roomObj = $roomHash{$roomNum};
if ($roomObj && $roomObj->zPosBlocks == $level) {
$roomXBlocks = $roomObj->xPosBlocks * $self->currentRegionmap->blockWidthPixels;
$roomYBlocks
= $roomObj->yPosBlocks * $self->currentRegionmap->blockHeightPixels;
if (
($roomXBlocks + $borderX1) <= $x2
&& ($roomXBlocks + $borderX2) >= $x1
&& ($roomYBlocks + $borderY1) <= $y2
&& ($roomYBlocks + $borderY2) >= $y1
) {
push (@selectList, $roomObj, 'room');
}
}
}
# Find a list of labels whose start position is within the selection box
foreach my $labelObj ($self->currentRegionmap->ivValues('gridLabelHash')) {
my ($listRef, $canvasObj, $boundsObj, $labelX1, $labelY1, $labelX2, $labelY2);
if ($labelObj->level == $level) {
$listRef = $self->currentParchment->getDrawnLabel($labelObj);
if (defined $listRef) {
# If the label has a box, use the boundaries of the box; otherwise use the
# boundaries of the label text
if ($labelObj->boxFlag && defined $$listRef[1]) {
$canvasObj = $$listRef[1];
} else {
$canvasObj = $$listRef[0];
}
$boundsObj = $canvasObj->get_bounds();
if (
$boundsObj->x1 <= $x2
&& $boundsObj->x2 >= $x1
&& $boundsObj->y1 <= $y2
&& $boundsObj->y2 >= $y1
) {
push (@selectList, $labelObj, 'label');
}
}
}
}
}
# Search complete. If the CTRL keys are held down, add the rooms/labels to any objects which
# are already selected; otherwise select just these objects
if (! ($event->state =~ m/control-mask/)) {
$self->setSelectedObj();
}
$self->setSelectedObj(\@selectList, TRUE);
return 1;
}
sub doQuickPaint {
# Called by $self->canvasEventHandler when a left-click is detected on any room while
# $self->toolbarQuickPaintColour is set
# Toggles room flags in the clicked room. If it's a selected room, toggles room flags in
# all selected rooms
#
# Expected arguments
# $clickRoomObj - The room that was left-clicked by the user
#
# Return values
# 'undef' on improper arguments or if none of the buttons in the quick painting toolbar
# are selected
# 1 otherwise
my ($self, $clickRoomObj, $check) = @_;
# Local variables
my @roomList;
# Check for improper arguments
if (! defined $clickRoomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doQuickPaint', @_);
}
# Do nothing if none of the colour buttons in the quick painting toolbar are selected
if (! $self->toolbarQuickPaintColour) {
return undef;
}
# If the room is a selected room, room flags should be toggled in all rooms
if (
($self->selectedRoom && $self->selectedRoom eq $clickRoomObj)
|| $self->ivExists('selectedRoomHash', $clickRoomObj->number)
) {
push (@roomList, $self->compileSelectedRooms());
} else {
# Just toggle room flags in the clicked room
push (@roomList, $clickRoomObj);
}
# Toggle the room flag in those rooms
$self->worldModelObj->toggleRoomFlags(
$self->session,
TRUE, # Update automapper windows
$self->toolbarQuickPaintColour,
@roomList,
);
if (! $self->worldModelObj->quickPaintMultiFlag) {
# User wants the choice of room flag to reset after clicking on a room
$self->ivUndef('toolbarQuickPaintColour');
}
return 1;
}
sub doMerge {
# Called by $self->canvasEventHandler when a double-click is detected on the current room
# and the automapper object is set up to perform a merge (i.e.
# GA::Map::Obj->currentMatchFlag is TRUE)
# Also called by $self->enableRoomsColumnm ->enableRoomsPopupMenu and
# ->canvasObjEventHandler
#
# Prepares a call to GA::Obj::WorldModel->mergeMap, then makes the call
#
# Expected arguments
# $currentRoomObj - The room that is definitely to be merged with another room (at the
# moment, it's always the automapper object's current room)
#
# Optional arguments
# $targetRoomObj - When called by $self->canvasObjEventHandler, because
# GA::Obj::Map->currentMatchList specifies several rooms that match
# the current room, then this variable is the room that was clicked
# $noConfirmFlag - TRUE if the confirmation dialogue window should not be shown; FALSE
# (or 'undef') if it should be shown as usual
#
# Return values
# 'undef' on improper arguments, if the user declines to perform the operation after a
# prompt or if the merge operation fails
# 1 otherwise
my ($self, $currentRoomObj, $targetRoomObj, $noConfirmFlag, $check) = @_;
# Local variables
my (
$autoRescueFlag, $regionmapObj, $response,
@selectList, @otherRoomList, @labelList,
);
# Check for improper arguments
if (! defined $currentRoomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doMerge', @_);
}
if ($self->mapObj->ivNumber('currentMatchList') > 1 && ! $targetRoomObj) {
# GA::Obj::Map->currentMatchList specifies multiple rooms which match the current
# room (which are all selected), so allow the user to click on one of those rooms,
# after which this function is called again by $self->canvasObjEventHandler
$self->set_freeClickMode('merge_room');
# After a double-click on the current room, none of the matching rooms will be selected,
# so select them again
if (! $self->selectedRoom && ! $self->selectedRoomHash) {
foreach my $roomObj ($self->mapObj->currentMatchList) {
push (@selectList, $roomObj, 'room');
}
$self->setSelectedObj(\@selectList, TRUE);
}
} else {
# If $targetRoomObj was set by the calling function, then GA::Obj::Map->currentMatchList
# specifies multiple rooms which match the current room, and the user has clicked one
# of them
if (! $targetRoomObj) {
# Otherwise, GA::Obj::Map->currentMatchList specifies a single room which matches
# the current room
$targetRoomObj = $self->mapObj->ivIndex('currentMatchList', 0);
}
if (
$self->mapObj->rescueTempRegionObj
&& $self->mapObj->rescueTempRegionObj->number == $currentRoomObj->parent
) {
# In Auto-rescue mode, attempt to merge or move all of the rooms in the temporary
# region
$autoRescueFlag = TRUE;
$regionmapObj = $self->worldModelObj->ivShow(
'regionmapHash',
$self->mapObj->rescueTempRegionObj->name,
);
foreach my $roomNum ($regionmapObj->ivValues('gridRoomHash')) {
# @otherRoomList shouldn't contain $currentRoomObj or $targetRoomObj
if (
$roomNum != $currentRoomObj->number
&& $roomNum != $targetRoomObj->number
) {
push (@otherRoomList, $self->worldModelObj->ivShow('modelHash', $roomNum));
}
}
} else {
# Otherwise, attempt to merge or move the $currentRoomObj and any other selected
# rooms that are in the same region
foreach my $roomObj ($self->compileSelectedRooms()) {
if (
$roomObj ne $targetRoomObj
&& $roomObj ne $currentRoomObj
&& $roomObj->parent eq $currentRoomObj->parent
&& ! defined $self->mapObj->ivFind('currentMatchList', $roomObj)
) {
push (@otherRoomList, $roomObj);
}
}
# Because we're not in auto-rescue mode, prompt the user before merging/moving more
# than one room
if (@otherRoomList && ! $noConfirmFlag) {
$response = $self->showMsgDialogue(
'Merge/move rooms',
'question',
'Are you sure you want to merge/move ' . ((scalar @otherRoomList) + 1)
. ' rooms?',
'yes-no',
);
if (! defined $response || $response ne 'yes') {
return undef;
}
}
# Get the regionmap for the code just below
$regionmapObj = $self->findRegionmap($currentRoomObj->parent);
}
# Any selected labels in the same region as $currentRoomObj should also be moved
foreach my $labelObj ($self->compileSelectedLabels()) {
if ($labelObj->region eq $regionmapObj->name) {
push (@labelList, $labelObj);
}
}
# Merge the room(s)
if (
! $self->worldModelObj->mergeMap(
$self->session,
$targetRoomObj,
$currentRoomObj,
\@otherRoomList,
\@labelList,
)
) {
# Merge operation failed
$self->showMsgDialogue(
'Merge/move rooms',
'error',
'Merge operation failed',
'ok',
);
if ($autoRescueFlag) {
# Auto-rescue mode was already activated, but rooms can't be moved from the
# temporary region back to the previous region
# Treat the temporary region as an ordinary temporary region from now on
$self->mapObj->reset_rescueRegion();
}
return undef;
} elsif ($autoRescueFlag) {
# Merge operation succeeded, and auto-rescue mode was already activated, so we can
# discard the temporary region
$self->worldModelObj->deleteRegions(
$self->session,
TRUE, # Update automapper windows now
$self->mapObj->rescueTempRegionObj,
);
# The GA::Obj::Map IVs should have been reset, but there's no harm in checking
$self->mapObj->reset_rescueRegion();
}
}
return 1;
}
sub checkMouseClick {
# Called by $self->canvasEventHandler and ->canvasObjEventHandler
# After an event caused by a mouse click, checks the event to find out whether it was a
# single/double/triple click, which button was used (left or right), and whether the SHIFT
# and/or CTRL keys were held down during the click
#
# Expected arguments
# $event - The Gtk3::Gdk::Event caused by the mouse click
#
# Return values
# An empty list on improper arguments, or if $event wasn't cause by a single, double or
# triple-mouse click, or by the user releasing the mouse button but by something else
# - mouse motion, perhaps
# Otherwise, returns a list in the form ($clickType, $button, $shiftFlag, $ctrlFlag):
# $clickType - 'single', 'double' or 'triple' or 'release'
# $button - 'left' or 'right'
# $shiftFlag - Set to TRUE if the SHIFT key was held down during the click, set to
# FALSE otherwise
# $ctrlFlag - Set to TRUE if the CTRL key was held down during the click, set to
# FALSE otherwise
my ($self, $event, $check) = @_;
# Local variables
my (
$clickType, $button, $shiftFlag, $ctrlFlag,
@emptyList,
);
# Check for improper arguments
if (! defined $event || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->checkMouseClick', @_);
return @emptyList;
}
# Set the type of click
if ($event->type eq 'button-press') {
$clickType = 'single';
} elsif ($event->type eq '2button-press') {
$clickType = 'double';
} elsif ($event->type eq '3button-press') {
$clickType = 'triple';
} elsif ($event->type eq 'button-release') {
$clickType = 'release';
} else {
# Not an event we're interested in
return @emptyList;
}
# Set the button
if ($event->button == 1) {
$button = 'left';
} elsif ($event->button == 3) {
$button = 'right';
} else {
# Not an event we're interested in
return @emptyList;
}
# Check whether the SHIFT and/or CTRL keys were held down, when the mouse was clicked
if ($event->state =~ m/shift-mask/) {
$shiftFlag = TRUE;
} else {
$shiftFlag = FALSE;
}
if ($event->state =~ m/control-mask/) {
$ctrlFlag = TRUE;
} else {
$ctrlFlag = FALSE;
}
return ($clickType, $button, $shiftFlag, $ctrlFlag);
}
sub showTooltips {
# Called by $self->setupCanvasObjEvent
# Shows tooltips (assumes the GA::Obj::WorldModel->showTooltipsFlag is TRUE)
#
# Expected arguments
# $type - What type of canvas object caused the mouse event - 'room', 'room_tag',
# 'room_guild', 'exit', 'exit_tag' or 'label'
# $canvasObj - The canvas object itself
# $modelObj - The GA::ModelObj::Room, GA::Obj::Exit or GA::Obj::MapLabel which
# corresponds to the canvas object $canvasObj
#
# Return values
# 'undef' on improper arguments or if the Automapper window isn't ready and active
# 1 otherwise
my ($self, $type, $canvasObj, $modelObj, $check) = @_;
# Local variables
my ($xPos, $yPos, $label);
# Check for improper arguments
if (! defined $type || ! defined $canvasObj || ! defined $modelObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->showTooltips', @_);
}
# Don't show tooltips if the Automapper window isn't ready and active
if (! $self->canvasFrame || ! $self->winWidget->is_active()) {
return undef;
}
# Get the label to draw
$label = $self->setTooltips($type, $modelObj);
if ($label) {
$self->canvasFrame->set_tooltip_text($label);
$self->ivPoke('canvasTooltipObj', $canvasObj);
$self->ivPoke('canvasTooltipObjType', $type);
$self->ivPoke('canvasTooltipFlag', TRUE);
}
return 1;
}
sub hideTooltips {
# Called by $self->setupCanvasObjEvent and several other functions
# Hides tooltips, if visible
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->hideTooltips', @_);
}
# Hide tooltips, if visible
if ($self->canvasFrame && $self->canvasTooltipObj) {
$self->canvasFrame->set_tooltip_text('');
$self->ivUndef('canvasTooltipObj');
$self->ivUndef('canvasTooltipObjType');
$self->ivPoke('canvasTooltipFlag', FALSE);
}
return 1;
}
sub setTooltips {
# Called by $self->showTooltips
# Compiles the text to show in the tooltips window, and returns it
#
# Expected arguments
# $type - What type of canvas object caused the mouse event - 'room', 'room_tag',
# 'room_guild', 'exit', 'exit_tag' or 'label'
# $modelObj - The GA::ModelObj::Room, GA::Obj::Exit or GA::Obj::MapLabel which
# corresponds to the canvas object $canvasObj
#
# Return values
# 'undef' on improper arguments
# Otherwise returns the text to display in the tooltips window
my ($self, $type, $modelObj, $check) = @_;
# Local variables
my (
$label, $vNum, $name, $area, $worldX, $worldY, $worldZ, $text, $flag, $standardDir,
$abbrevDir, $parentRoomObj, $destRoomObj, $twinExitObj, $xPos, $yPos, $modText,
);
# Check for improper arguments
if (! defined $type || ! defined $modelObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setTooltips', @_);
}
if ($type eq 'room') {
$label = "Room #" . $modelObj->number;
if ($modelObj->roomTag) {
$label .= " \'" . $modelObj->roomTag . "\'";
}
# Show the room's coordinates on the map
$label .= " (" . $modelObj->xPosBlocks . ", " . $modelObj->yPosBlocks;
$label .= ", " . $modelObj->zPosBlocks . ")";
# Show the world's room vnum, etc (if known)
if ($modelObj->protocolRoomHash) {
$label .= "\nWorld:";
$vNum = $modelObj->ivShow('protocolRoomHash', 'vNum');
if (defined $vNum) {
$label .= "#" . $vNum;
}
$name = $modelObj->ivShow('protocolRoomHash', 'name');
if (defined $name) {
$label .= " " . $name;
}
$area = $modelObj->ivShow('protocolRoomHash', 'area');
if (defined $area) {
$label .= " " . $area;
}
$worldZ = $modelObj->ivShow('protocolRoomHash', 'zpos');
if (! defined $worldZ) {
# (Guard against X being defined, but Y/Z not being defined, etc
$worldZ = "?";
}
$worldY = $modelObj->ivShow('protocolRoomHash', 'ypos');
if (! defined $worldY) {
$worldY = "?";
}
$worldX = $modelObj->ivShow('protocolRoomHash', 'xpos');
if (defined $worldX) {
$label .= " $worldX-$worldY-$worldY";
}
}
# Add the room title (if there is one)
if ($modelObj->titleList) {
# Using the first item in the list, use the whole title
$label .= "\n(T) " . $modelObj->ivFirst('titleList');
$flag = TRUE;
}
# Add a (verbose) description (if there is one)
if ($modelObj->descripHash) {
# Use the description matching the current light status, if it exists
if (
$self->worldModelObj->lightStatus
&& $modelObj->ivExists('descripHash', $self->worldModelObj->lightStatus)
) {
$text = $modelObj->ivShow('descripHash', $self->worldModelObj->lightStatus);
} else {
# Cycle through light statuses, looking for a matching verbose description
OUTER: foreach my $status ($self->worldModelObj->lightStatusList) {
if ($modelObj->ivExists('descripHash', $status)) {
$text = $modelObj->ivShow('descripHash', $status);
last OUTER;
}
}
}
if ($text) {
# Split the text into two lines of no more than 40 characters. The TRUE
# arguments tells the function to append an ellipsis, if any text is
# removed
$text = $axmud::CLIENT->splitText($text, 2, 40, TRUE);
$label .= "\n(D) " . $text;
$flag = TRUE;
}
}
# Add the room's source code path (if set)
if ($modelObj->sourceCodePath) {
$label .= "\n(S) " . $modelObj->sourceCodePath;
$flag = TRUE;
}
# If there is no title or (verbose) description available, show an explanatory message
if (! $flag) {
$label .= "\n(No description available)";
}
# Show room notes (if set)
if ($self->worldModelObj->showNotesFlag && $modelObj->notesList) {
$text = $axmud::CLIENT->trimWhitespace(join(' ', $modelObj->notesList), TRUE);
# Split the text into five lines of no more than 40 characters, appending an
# ellipsis
$text = $axmud::CLIENT->splitText($text, 5, 40, TRUE);
$label .= "\n(N) " . $text;
}
} elsif ($type eq 'room_tag') {
$label = "Room tag \'" . $modelObj->roomTag . "\'";
$label .= "\n Room #" . $modelObj->number;
# Show the room's coordinates on the map
$label .= " (" . $modelObj->xPosBlocks . ", " . $modelObj->yPosBlocks;
$label .= ", " . $modelObj->zPosBlocks . ")";
} elsif ($type eq 'room_guild') {
$label = "Room guild \'" . $modelObj->roomGuild . "\'";
$label .= "\n Room #" . $modelObj->number;
# Show the room's coordinates on the map
$label .= " (" . $modelObj->xPosBlocks . ", " . $modelObj->yPosBlocks;
$label .= ", " . $modelObj->zPosBlocks . ")";
} elsif ($type eq 'exit') {
$label = "Exit #" . $modelObj->number . " \'" . $modelObj->dir . "\'";
# Get the standard form of the exit's direction so we can compare it with the exit's
# map direction, ->mapDir
$standardDir = $self->session->currentDict->ivShow('combRevDirHash', $modelObj->dir);
if (
$standardDir
&& $modelObj->mapDir
&& $modelObj->mapDir ne $standardDir
) {
# Convert the allocated map direction to its abbreviated form
$abbrevDir = $self->session->currentDict->ivShow(
'primaryAbbrevHash',
$modelObj->mapDir,
);
if (! $abbrevDir) {
# We're forced to use the unabbreviated form
$abbrevDir = $modelObj->mapDir;
}
$label .= " (> " . $abbrevDir . ")";
}
$parentRoomObj = $self->worldModelObj->ivShow('modelHash', $modelObj->parent);
$label .= "\n Parent room #" . $parentRoomObj->number;
if ($modelObj->destRoom) {
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $modelObj->destRoom);
$label .= "\n Destination room #" . $destRoomObj->number;
}
if ($modelObj->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow('exitModelHash', $modelObj->twinExit);
$label .= "\n Twin exit #" . $twinExitObj->number . " \'" . $twinExitObj->dir
. "\'";
}
if (defined $modelObj->altDir) {
$label .= "\n Alternative directions:\n " . $modelObj->altDir;
}
if ($modelObj->exitInfo) {
$label .= "\n Info: " . $modelObj->exitInfo;
}
} elsif ($type eq 'exit_tag') {
$label = "Exit tag \'" . $modelObj->exitTag . "\'";
$label .= "\n Exit #" . $modelObj->number . " \'" . $modelObj->dir . "\'";
} elsif ($type eq 'label') {
$label = "Label #" . $modelObj->number;
# Convert the label's coordinates in pixels to gridblocks
$xPos = int($modelObj->xPosPixels / $self->currentRegionmap->blockWidthPixels);
$yPos = int($modelObj->yPosPixels / $self->currentRegionmap->blockHeightPixels);
$label .= " (" . $xPos . ", " . $yPos . ", " . $modelObj->level . ")";
if (! defined $modelObj->style) {
$label .= "\nStyle: <custom>";
} else {
$label .= "\nStyle: \'" . $modelObj->style . "\'";
}
# (The text can include a lot of empty space and newline characters, so strip all of
# that)
$modText = $modelObj->name;
$modText =~ s/^[\s\n]*//;
$modText =~ s/[\s\n]*$//;
$modText =~ s/[\s\n]+/ /g;
$label .= "\nText: \'" . $modText . "\'";
} else {
# Failsafe: empty string
$label = "";
}
return $label;
}
# Menu 'File' column callbacks
sub importModelCallback {
# Called by $self->enableFileColumn
# Imports a world model file specified by the user and (if successful) loads it into memory
# (a combination of ';importfiles' and ';load -m')
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->importModelCallback', @_);
}
# (No standard callback checks for this function)
# Watch out for file operation failures
$axmud::CLIENT->set_fileFailFlag(FALSE);
# Allow a world model, associated with a world profile with a different name, to be imported
# into the current world's file structures (but only if the archive file contains only a
# world model)
$self->session->set_transferWorldModelFlag(TRUE);
# Import a file, specified by the user
if (
$self->session->pseudoCmd('importfiles')
&& ! $axmud::CLIENT->fileFailFlag
) {
# The world model data has been incorporated into Axmud's data files, but not loaded
# into memory. Load it into memory now
if (
$self->session->pseudoCmd('load -m')
&& ! $axmud::CLIENT->fileFailFlag
) {
# Make sure the world model object has the right parent world set, after the file
# import
$self->session->worldModelObj->{_parentWorld} = $self->session->currentWorld->name;
# Save the world model, to make sure the file has the right parent world set, too
$self->session->pseudoCmd('save -f -m');
}
}
# Reset the flag
$self->session->set_transferWorldModelFlag(FALSE);
return 1;
}
sub exportModelCallback {
# Called by $self->enableFileColumn
# Saves the current world model and (if successful) exports the 'worldmodel' file to a
# folder specified by the user (a combination of ';save -m' and ';exportfiles -m'
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($fileObj, $choice);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->exportModelCallback', @_);
}
# (No standard callback checks for this function)
# If the world model data in memory is unsaved, prompt whether to save it first
$fileObj = $self->session->ivShow('sessionFileObjHash', 'worldmodel');
if ($fileObj && $fileObj->modifyFlag) {
# Watch out for file operation failures
$axmud::CLIENT->set_fileFailFlag(FALSE);
# Prompt the user
$choice = $self->showMsgDialogue(
'Unsaved world model',
'question',
'The world model in memory is not saved. Do you want to save it before exporting?'
. ' (If you choose \'No\', the previously saved world model file will be exported'
. ' instead)',
'yes-no',
);
if ($choice eq 'yes') {
# Save the world model
$self->session->pseudoCmd('save -m', 'win_error');
if ($axmud::CLIENT->fileFailFlag) {
# Something went wrong; don't attempt to export anything
return 1;
}
}
}
# Export the world model data file
$self->session->pseudoCmd(
'exportfiles -m ' . $self->session->currentWorld->name,
'win_error',
);
return 1;
}
# Menu 'Edit' column callbacks
sub selectInRegionCallback {
# Called by $self->enableEditColumn
# Selects rooms, exits, room tags, room guilds or labels (or everything) in the current
# region
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $type - Set to 'room', 'exit', 'room_tag', 'room_guild', or 'label'. If not defined,
# selects everything
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$count,
@roomList, @exitList, @roomTagList, @roomGuildList, @labelList,
%roomHash, %exitHash, %roomTagHash, %roomGuildHash, %labelHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectInRegionCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Make sure there are no rooms, exits, room tags or labels selected
$self->ivUndef('selectedRoom');
$self->ivEmpty('selectedRoomHash');
$self->ivUndef('selectedExit');
$self->ivEmpty('selectedExitHash');
$self->ivUndef('selectedRoomTag');
$self->ivEmpty('selectedRoomTagHash');
$self->ivUndef('selectedRoomGuild');
$self->ivEmpty('selectedRoomGuildHash');
$self->ivUndef('selectedLabel');
$self->ivEmpty('selectedLabelHash');
# Select all rooms, exits, room tags, room guilds and/or labels
if (! defined $type || $type eq 'room') {
# $self->currentRegionmap->gridRoomHash contains all the rooms in the regionmap
# Get a list of world model numbers for each room
@roomList = $self->currentRegionmap->ivValues('gridRoomHash');
}
if (! defined $type || $type eq 'exit') {
# ->gridExitHash contains all the drawn exits
# Get a list of exit model numbers for each exit
@exitList = $self->currentRegionmap->ivKeys('gridExitHash');
}
if (! defined $type || $type eq 'room_tag') {
# ->gridRoomTagHash contains all the rooms with room tags
# Get a list of world model numbers for the rooms containing room tag
@roomTagList = $self->currentRegionmap->ivValues('gridRoomTagHash');
}
if (! defined $type || $type eq 'room_guild') {
# ->gridRoomGuildHash contains all the rooms with room guilds
# Get a list of world model numbers for the roomw containing room guilds
@roomGuildList = $self->currentRegionmap->ivValues('gridRoomGuildHash');
}
if (! defined $type || $type eq 'label') {
# ->gridLabelHash contains all the labels
# Get a list of blessed references to GA::Obj::MapLabel objects
@labelList = $self->currentRegionmap->ivValues('gridLabelHash');
}
# The IVs that store selected objects behave differently when there is one selected object
# and when there is more than one. Count how many selected objects we have
$count = (scalar @roomList) + (scalar @exitList) + (scalar @roomTagList)
+ (scalar @roomGuildList) + (scalar @labelList);
# Select a single object...
if ($count == 1) {
if (@roomList) {
# Select the blessed reference of a GA::ModelObj::Room
$self->ivPoke(
'selectedRoom',
$self->worldModelObj->ivShow('modelHash', $roomList[0]),
);
} elsif (@exitList) {
# Select the blessed reference of a GA::Obj::Exit
$self->ivPoke(
'selectedExit',
$self->worldModelObj->ivShow('exitModelHash', $exitList[0]),
);
} elsif (@roomTagList) {
# Select the blessed reference of the GA::ModelObj::Room which contains the room
# tag
$self->ivPoke(
'selectedRoomTag',
$self->worldModelObj->ivShow('modelHash', $roomTagList[0]),
);
} elsif (@roomGuildList) {
# Select the blessed reference of the GA::ModelObj::Room which contains the room
# guild
$self->ivPoke(
'selectedRoomGuild',
$self->worldModelObj->ivShow('modelHash', $roomGuildList[0]),
);
} elsif (@labelList) {
# Select the blessed reference of a GA::Obj::MapLabel
$self->ivPoke('selectedLabel', $labelList[0]);
}
# ...or select multiple objects
} else {
# (For speed, update local variable hashes, before storing the whole hash(es) in IVs
foreach my $number (@roomList) {
$roomHash{$number} = $self->worldModelObj->ivShow('modelHash', $number);
}
foreach my $number (@exitList) {
$exitHash{$number} = $self->worldModelObj->ivShow('exitModelHash', $number);
}
foreach my $number (@roomTagList) {
$roomTagHash{$number} = $self->worldModelObj->ivShow('modelHash', $number);
}
foreach my $number (@roomGuildList) {
$roomGuildHash{$number} = $self->worldModelObj->ivShow('modelHash', $number);
}
foreach my $obj (@labelList) {
$labelHash{$obj->id} = $obj;
}
# Update the IVs
$self->ivPoke('selectedRoomHash', %roomHash);
$self->ivPoke('selectedExitHash', %exitHash);
$self->ivPoke('selectedRoomTagHash', %roomTagHash);
$self->ivPoke('selectedRoomGuildHash', %roomGuildHash);
$self->ivPoke('selectedLabelHash', %labelHash);
}
# Redraw the current region
$self->redrawRegions();
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
sub selectInMapCallback {
# Called by $self->enableEditColumn
# Selects rooms, exits, room tags, room guilds or labels (or everything) in all regions
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $type - Set to 'room', 'exit', 'room_tag', 'room_guild', or 'label'. If not defined,
# selects everything
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$count,
@roomList, @exitList, @roomTagList, @roomGuildList, @labelList,
%roomHash, %exitHash, %roomTagHash, %roomGuildHash, %labelHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectInMapCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Make sure there are no rooms, exits, room tags or labels selected
$self->ivUndef('selectedRoom');
$self->ivEmpty('selectedRoomHash');
$self->ivUndef('selectedExit');
$self->ivEmpty('selectedExitHash');
$self->ivUndef('selectedRoomTag');
$self->ivEmpty('selectedRoomTagHash');
$self->ivUndef('selectedRoomGuild');
$self->ivEmpty('selectedRoomGuildHash');
$self->ivUndef('selectedLabel');
$self->ivEmpty('selectedLabelHash');
# Select all rooms, exits, room tags, room guilds and/or labels
if (! defined $type || $type eq 'room') {
@roomList = $self->worldModelObj->ivValues('modelHash');
}
if (! defined $type || $type eq 'exit') {
@exitList = $self->worldModelObj->ivValues('exitModelHash');
}
foreach my $regionmapObj ($self->worldModelObj->ivValues('regionmapHash')) {
if (! defined $type || $type eq 'room_tag') {
# ->gridRoomTagHash contains all the rooms with room tags
# Get a list of world model numbers for the rooms containing room tag
push (@roomTagList, $regionmapObj->ivValues('gridRoomTagHash'));
}
if (! defined $type || $type eq 'room_guild') {
# ->gridRoomGuildHash contains all the rooms with room guilds
# Get a list of world model numbers for the roomw containing room guilds
push (@roomGuildList, $regionmapObj->ivValues('gridRoomGuildHash'));
}
if (! defined $type || $type eq 'label') {
# ->gridLabelHash contains all the labels
# Get a list of blessed references to GA::Obj::MapLabel objects
push (@labelList, $regionmapObj->ivValues('gridLabelHash'));
}
}
# The IVs that store selected objects behave differently when there is one selected object
# and when there is more than one. Count how many selected objects we have
$count = (scalar @roomList) + (scalar @exitList) + (scalar @roomTagList)
+ (scalar @roomGuildList) + (scalar @labelList);
# Select a single object...
if ($count == 1) {
if (@roomList) {
# Select the blessed reference of a GA::ModelObj::Room
$self->ivPoke(
'selectedRoom',
$self->worldModelObj->ivShow('modelHash', $roomList[0]),
);
} elsif (@exitList) {
# Select the blessed reference of a GA::Obj::Exit
$self->ivPoke(
'selectedExit',
$self->worldModelObj->ivShow('exitModelHash', $exitList[0]),
);
} elsif (@roomTagList) {
# Select the blessed reference of the GA::ModelObj::Room which contains the room
# tag
$self->ivPoke(
'selectedRoomTag',
$self->worldModelObj->ivShow('modelHash', $roomTagList[0]),
);
} elsif (@roomGuildList) {
# Select the blessed reference of the GA::ModelObj::Room which contains the room
# guild
$self->ivPoke(
'selectedRoomGuild',
$self->worldModelObj->ivShow('modelHash', $roomGuildList[0]),
);
} elsif (@labelList) {
# Select the blessed reference of a GA::Obj::MapLabel
$self->ivPoke('selectedLabel', $labelList[0]);
}
# ...or select multiple objects
} else {
# (For speed, update local variable hashes, before storing the whole hash(es) in IVs
foreach my $number (@roomList) {
$roomHash{$number} = $self->worldModelObj->ivShow('modelHash', $number);
}
foreach my $number (@exitList) {
$exitHash{$number} = $self->worldModelObj->ivShow('exitModelHash', $number);
}
foreach my $number (@roomTagList) {
$roomTagHash{$number} = $self->worldModelObj->ivShow('modelHash', $number);
}
foreach my $number (@roomGuildList) {
$roomGuildHash{$number} = $self->worldModelObj->ivShow('modelHash', $number);
}
foreach my $obj (@labelList) {
$labelHash{$obj->id} = $obj;
}
# Update the IVs
$self->ivPoke('selectedRoomHash', %roomHash);
$self->ivPoke('selectedExitHash', %exitHash);
$self->ivPoke('selectedRoomTagHash', %roomTagHash);
$self->ivPoke('selectedRoomGuildHash', %roomGuildHash);
$self->ivPoke('selectedLabelHash', %labelHash);
}
# Redraw the current region's current level now, and mark all other levels in the same
# region (as well as any other regions for which a parchment exists) as needing to be
# drawn
$self->drawAllRegions();
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
sub selectRoomCallback {
# Called by $self->enableEditColumn
# Selects certain rooms
#
# Expected arguments
# $type - Set to 'no_title', 'no_descrip', 'no_title_descrip', 'title_descrip',
# 'no_visit_char', 'no_visit_all', 'visit_char', 'visit_all', 'checkable'
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if no matching
# rooms are found
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$title, $msg,
@roomList, @selectList,
%dirHash,
);
# Check for improper arguments
if (! defined $type || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectRoomCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Import a list of all rooms in the current region (for convenience)
foreach my $roomNum ($self->currentRegionmap->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('roomModelHash', $roomNum);
if ($roomObj) {
push (@roomList, $roomObj);
}
}
# Compile a list of matching rooms
if ($type eq 'no_title') {
$title = 'Select rooms with no titles';
foreach my $roomObj (@roomList) {
if ($roomObj && ! $roomObj->titleList) {
push (@selectList, $roomObj, 'room');
}
}
} elsif ($type eq 'no_descrip') {
$title = 'Select rooms with no descriptions';
foreach my $roomObj (@roomList) {
if (! $roomObj->descripHash) {
push (@selectList, $roomObj, 'room');
}
}
} elsif ($type eq 'no_title_descrip') {
$title = 'Select rooms with no titles or descriptions';
foreach my $roomObj (@roomList) {
if (! $roomObj->titleList && ! $roomObj->descripHash) {
push (@selectList, $roomObj, 'room');
}
}
} elsif ($type eq 'title_descrip') {
$title = 'Select rooms with titles and descriptions';
foreach my $roomObj (@roomList) {
if ($roomObj->titleList && $roomObj->descripHash) {
push (@selectList, $roomObj, 'room');
}
}
} elsif ($type eq 'no_visit_char' && $self->session->currentChar) {
$title = 'Select unvisited rooms';
foreach my $roomObj (@roomList) {
if (! $roomObj->ivShow('visitHash', $self->session->currentChar->name)) {
push (@selectList, $roomObj, 'room');
}
}
} elsif ($type eq 'no_visit_all') {
$title = 'Select unvisited rooms';
foreach my $roomObj (@roomList) {
if (! $roomObj->visitHash) {
push (@selectList, $roomObj, 'room');
}
}
} elsif ($type eq 'visit_char' && $self->session->currentChar) {
$title = 'Select visited rooms';
foreach my $roomObj (@roomList) {
if ($roomObj->ivShow('visitHash', $self->session->currentChar->name)) {
push (@selectList, $roomObj, 'room');
}
}
} elsif ($type eq 'visit_all') {
$title = 'Select visited rooms';
foreach my $roomObj (@roomList) {
if ($roomObj->visitHash) {
push (@selectList, $roomObj, 'room');
}
}
} elsif ($type eq 'checkable') {
$title = 'Select rooms with checkable directions';
# Get a hash of custom primary directions which can be checked in each room
%dirHash = $self->worldModelObj->getCheckableDirs($self->session);
foreach my $roomObj (@roomList) {
my %checkHash = %dirHash;
foreach my $dir ($roomObj->ivKeys('checkedDirHash')) {
delete $checkHash{$dir};
}
foreach my $dir ($roomObj->sortedExitList) {
delete $checkHash{$dir};
}
if (%checkHash) {
push (@selectList, $roomObj, 'room');
}
}
}
# Show a confirmation in both cases. Even if matching rooms are found, they might not be
# visible
if (! @selectList) {
$self->showMsgDialogue(
$title,
'error',
'No matching rooms found in this region',
'ok',
);
return undef;
} else {
# Make sure nothing is selected
$self->setSelectedObj();
# Select matching rooms
$self->setSelectedObj(\@selectList, TRUE);
if (@selectList == 2) {
$msg = '1 matching room found in this region';
} else {
$msg = ((scalar @selectList) / 2) . ' matching rooms found in this region';
}
$self->showMsgDialogue(
$title,
'info',
$msg,
'ok',
);
return 1;
}
}
sub selectExitTypeCallback {
# Called by $self->enableEditColumn
# Scours the current map, looking for unallocated, unallocatable, uncertain or incomplete
# exits (or all four of them together)
# Once found, selects both the exits and the parent rooms
# Finally, displays a 'dialogue' window showing how many were found
#
# Expected arguments
# $type - What to search for. Must be either 'in_rooms' 'unallocated', 'unallocatable,
# 'uncertain', 'incomplete', 'all_above', 'impass', 'mystery', 'region' or
# 'super'
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$obj, $number, $title, $text,
@exitNumList, @exitObjList,
%roomHash, %selectExitHash, %selectRoomHash,
);
# Check for improper arguments
if (
! defined $type
|| (
$type ne 'in_rooms' && $type ne 'uncertain' && $type ne 'incomplete'
&& $type ne 'unallocated' && $type ne 'unallocatable' && $type ne 'all_above'
&& $type ne 'impass' && $type ne 'mystery' && $type ne 'region' && $type ne 'super'
) || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectExitTypeCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Compile a list of all exit objects drawn in this map
@exitNumList = $self->currentRegionmap->ivKeys('gridExitHash');
foreach my $exitNum (@exitNumList) {
push (@exitObjList, $self->worldModelObj->ivShow('exitModelHash', $exitNum));
}
if ($type eq 'in_rooms') {
# Import a list of all the selected rooms, and copy them into a hash
if ($self->selectedRoom) {
$roomHash{$self->selectedRoom->number} = $self->selectedRoom;
} else {
%roomHash = $self->selectedRoomHash;
}
# Check each selected room in turn, marking all of its exits for selection
foreach my $roomObj (values %roomHash) {
foreach my $exitNum ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
if ($exitObj) {
$selectExitHash{$exitNum} = $exitObj;
}
}
}
} else {
# Check each exit in turn. If it's one of the exits for which we're looking, mark it for
# selection
OUTER: foreach my $exitObj (@exitObjList) {
if (
(
($type eq 'uncertain' || $type eq 'all_above')
&& $exitObj->destRoom
&& (! $exitObj->twinExit)
&& (! $exitObj->oneWayFlag)
&& (! $exitObj->retraceFlag)
) || (
($type eq 'incomplete' || $type eq 'all_above')
&& (! $exitObj->destRoom && $exitObj->randomType eq 'none')
) || (
($type eq 'unallocated' || $type eq 'all_above')
&& (
$exitObj->drawMode eq 'temp_alloc'
|| $exitObj->drawMode eq 'temp_unalloc'
)
) || (
$type eq 'unallocatable' && $exitObj->drawMode eq 'temp_unalloc'
) || (
$type eq 'impass' && $exitObj->exitOrnament eq 'impass'
) || (
$type eq 'mystery' && $exitObj->exitOrnament eq 'mystery'
) || (
$type eq 'region' && $exitObj->regionFlag
) || (
$type eq 'super' && $exitObj->superFlag
)
) {
$selectExitHash{$exitObj->number} = $exitObj;
$selectRoomHash{$exitObj->parent}
= $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
}
}
}
# If anything was marked for selection...
if (%selectExitHash) {
# Since we're going to redraw everything on the map, we'll sidestep the normal call to
# $self->setSelectedObj, and set IVs directly
# Make sure there are no rooms, exits, room tags or labels selected
$self->ivUndef('selectedRoom');
$self->ivEmpty('selectedRoomHash');
$self->ivUndef('selectedExit');
$self->ivEmpty('selectedExitHash');
$self->ivUndef('selectedRoomTag');
$self->ivEmpty('selectedRoomTagHash');
$self->ivUndef('selectedLabel');
$self->ivEmpty('selectedLabelHash');
# Select rooms and exits. (There must be at least one of each, if there are any, so we
# don't ever set ->selectedRoom or ->selectedExit)
if (scalar (keys %selectRoomHash) > 1) {
$self->ivPoke('selectedRoomHash', %selectRoomHash);
} elsif (%selectRoomHash) {
($number) = keys %selectRoomHash;
$obj = $self->worldModelObj->ivShow('modelHash', $number);
$self->ivAdd('selectedRoomHash', $number, $obj);
}
if (scalar (keys %selectExitHash) > 1) {
$self->ivPoke('selectedExitHash', %selectExitHash);
} elsif (%selectExitHash) {
($number) = keys %selectExitHash;
$obj = $self->worldModelObj->ivShow('exitModelHash', $number);
$self->ivAdd('selectedExitHash', $number, $obj);
}
# Redraw the current region's current level now, and mark all other levels in the same
# region (as well as any other regions for which a parchment exists) as needing to be
# drawn
$self->drawAllRegions();
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# Show a confirmation of how many uncertain/incomplete exits were found
if ($type eq 'in_rooms') {
$title = 'Selected rooms\' exits';
# (This will be a shorter string, so keep it on one line)
if (scalar (keys %selectExitHash) == 1) {
$text = 'Found 1 exit in ';
} else {
$text = 'Found ' . scalar (keys %selectExitHash) . ' exits in ';
}
if (scalar (keys %roomHash) == 1) {
$text .= '1 selected room';
} else {
$text .= scalar (keys %roomHash) . ' selected rooms';
}
$text .= ' in this region';
} else {
if ($type eq 'all_above') {
$title = 'Select exits';
# (This will be a longer string, so spread it across two lines)
if (scalar (keys %selectExitHash) == 1) {
$text = "Found 1 unallocated/uncertain/incomplete exit\n";
} else {
$text = "Found " . scalar (keys %selectExitHash) . " unallocated/uncertain/"
. "incomplete exits\n";
}
} else {
$title = 'Select ' . $type . ' exits';
# (This will be a shorter string, so keep it on one line)
if (scalar (keys %selectExitHash) == 1) {
$text = "Found 1 $type exit ";
} else {
$text = "Found " . scalar (keys %selectExitHash) . " $type exits ";
}
}
if (scalar (keys %selectRoomHash) == 1) {
$text .= 'in 1 room';
} else {
$text .= 'spread across ' . scalar (keys %selectRoomHash) . ' rooms';
}
$text .= ' in this region';
}
$self->showMsgDialogue(
$title,
'info',
$text,
'ok',
undef,
TRUE, # Preserve newline characters in $text
);
} else {
# Show a confirmation that there are no uncertain/incomplete exits in this map
if ($type eq 'all_above') {
$title = 'Select exits';
$text = 'There are no more unallocated, uncertain or incomplete exits in this'
. ' region';
} else {
$title = 'Select ' . $type . ' exits';
$text = 'There are no more ' . $type . ' exits in this region';
}
$self->showMsgDialogue(
$title,
'info',
$text,
'ok',
);
}
return 1;
}
sub findRoomCallback {
# Called by $self->enableEditColumn
# Prompts the user to enter the world model number of a room, and then selects the room
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the user declines to specify a room number
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($msg, $choice, $obj, $num, $regionObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findRoomCallback', @_);
}
# (No standard callback checks for this function)
# Check that the world model isn't empty
if (! $self->worldModelObj->modelHash) {
return $self->showMsgDialogue(
'Find room',
'error',
'The world model is currently empty',
'ok',
);
}
# Prompt the user for a room number
$msg = 'Enter a room number';
if ($self->worldModelObj->modelObjCount > 1) {
$msg .= ' (range 1-' . $self->worldModelObj->modelObjCount . '), or enter a room tag';
} else {
$msg .= ' or enter a room tag';
}
$choice = $self->showEntryDialogue(
'Find room',
$msg,
);
if (! defined $choice) {
return undef;
}
# Is $choice a model number?
if ($axmud::CLIENT->intCheck($choice, 1)) {
# Does the corresponding world model object exist?
if (! $self->worldModelObj->ivExists('modelHash', $choice)) {
return $self->showMsgDialogue(
'Find room',
'error',
'There is no world model object #' . $choice,
'ok',
);
} else {
$obj = $self->worldModelObj->ivShow('modelHash', $choice);
}
} else {
# Find the room tag
$num = $self->worldModelObj->ivShow('roomTagHash', lc($choice));
if (defined $num) {
$obj = $self->worldModelObj->ivShow('modelHash', $num);
} else {
return $self->showMsgDialogue(
'Find room',
'error',
'There is no room tagged \'' . $choice . '\'',
'ok',
);
}
}
if ($obj->category ne 'room') {
if ($obj->category eq 'armour') {
$msg = 'The world model object #' . $obj->number . ' isn\'t a room (but an '
. $obj->category . ')';
} else {
$msg = 'The world model object #' . $obj->number . ' isn\'t a room (but a '
. $obj->category . ')';
}
return $self->showMsgDialogue(
'Find room',
'error',
$msg,
'ok',
);
}
if (! defined $obj->xPosBlocks) {
# Room not in a regionmap - very unlikely, but we'll display a message anyway
return $self->showMsgDialogue(
'Find room',
'error',
'The world model object #' . $obj->number . ' exists, but isn\'t on the map',
'ok',
);
}
# If there isn't a current regionmap, show the one containing the room
$regionObj = $self->worldModelObj->ivShow('modelHash', $obj->parent);
if (! $self->currentRegionmap && $regionObj) {
$self->setCurrentRegion($regionObj->name);
}
# If there is (now) a current regionmap, select the room (even if it's not in the same
# region)
if ($self->currentRegionmap) {
$self->setSelectedObj(
[$obj, 'room'],
FALSE, # Select this object; unselect all other objects
);
# Centre the map on the room
$self->centreMapOverRoom($self->selectedRoom);
}
# Prepare a message to display
$msg = "World model room #" . $obj->number . "\n\n";
$regionObj = $self->worldModelObj->ivShow('modelHash', $obj->parent);
if ($regionObj) {
$msg .= "Region: '" . $regionObj->name . "'\n";
} else {
$msg .= "Region: <none>\n";
}
$msg .= "X-pos: " . $obj->xPosBlocks . "\n";
$msg .= "Y-pos: " . $obj->yPosBlocks . "\n";
$msg .= "Level: " . $obj->zPosBlocks;
# Display info about the room
return $self->showMsgDialogue(
'Find room',
'info',
$msg,
'ok',
undef,
TRUE, # Preserve newline characters in $msg
);
}
sub findExitCallback {
# Called by $self->enableEditColumn
# Prompts the user to enter the exit model number of an exit, and then selects the exit
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the user declines to specify an room number
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($msg, $number, $exitObj, $roomObj, $regionObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findExitCallback', @_);
}
# (No standard callback checks for this function)
# Check that the exit model isn't empty
if (! $self->worldModelObj->exitModelHash) {
return $self->showMsgDialogue(
'Find exit',
'error',
'The exit model is currently empty',
'ok',
);
}
# Prompt the user for an exit number
$msg = 'Enter the exit number';
if ($self->worldModelObj->exitObjCount > 1) {
$msg .= ' (range 1-' . $self->worldModelObj->exitObjCount . ')';
}
$number = $self->showEntryDialogue(
'Find exit',
$msg,
);
# We need a positive integer
if (! $axmud::CLIENT->intCheck($number, 1)) {
# Do nothing
return undef;
}
# Does the corresponding exit model object exist?
if (! $self->worldModelObj->ivExists('exitModelHash', $number)) {
return $self->showMsgDialogue(
'Find exit',
'error',
'There is no exit model object #' . $number,
'ok',
);
} else {
# Get the blessed reference of the exit object and its parent room object
$exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
}
if (! defined $roomObj->xPosBlocks) {
# Parent room not in a regionmap - rather unlikely, but we'll display a message anyway
return $self->showMsgDialogue(
'Find exit',
'error',
'The exit\'s parent room (#' . $roomObj->number . ') exists, but isn\'t on the map',
'ok',
);
}
# If there isn't a current regionmap, show the one containing the exit
$regionObj = $self->worldModelObj->ivShow('modelHash', $roomObj->parent);
if (! $self->currentRegionmap && $regionObj) {
$self->setCurrentRegion($regionObj->name);
}
# If there is (now) a current regionmap, select the exit (even if it's not in that region)
if ($self->currentRegionmap) {
$self->setSelectedObj(
[$exitObj, 'exit'],
FALSE, # Select this object; unselect all other objects
);
# Centre the map on the parent room
$self->centreMapOverRoom($roomObj);
}
# Prepare a message to display
$msg = "Exit model object #" . $number . "\n\n";
$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;
} until (! @list2);
# Prompt the user to specify which data in which rooms is to be reset
($choice, $choice2) = $self->showDoubleComboDialogue(
'Reset room data',
'Choose what kind of data to reset',
'Choose which rooms to reset',
\@comboList,
\@comboList2,
);
if (! defined $choice) {
return undef;
}
# Convert the description 'Rooms in all regions' to the argument 'all_rooms', etc
$choice = $comboHash{$choice};
$choice2 = $comboHash2{$choice2};
# If more than one room is to be reset, get a confirmation before doing anything
if ($choice2 eq 'current') {
if ($self->mapObj->currentRoom) {
push (@roomList, $self->mapObj->currentRoom);
}
} elsif ($choice2 eq 'selected') {
if ($self->selectedRoom) {
push (@roomList, $self->selectedRoom);
} else {
push (@roomList, $self->ivValues('selectedRoomHash'));
}
} elsif ($choice2 eq 'region') {
foreach my $roomNum ($self->currentRegionmap->ivValues('gridRoomHash')) {
push (@roomList, $self->worldModelObj->ivShow('modelHash', $roomNum));
}
} elsif ($choice2 eq 'all_rooms') {
push (@roomList, $self->worldModelObj->ivValues('roomModelHash'));
}
if (! @roomList) {
$self->showMsgDialogue(
'Reset room data',
'error',
'No matching rooms found',
'ok',
);
return undef;
} elsif (@roomList > 1) {
$response = $self->showMsgDialogue(
'Reset room data',
'question',
'This operation will reset data in ' . (scalar @roomList) . ' rooms. Are you sure'
. ' you want to proceed?',
'yes-no',
);
if (! defined $response || $response ne 'yes') {
return undef;
}
}
# 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;
}
# Check that some characters and regions are specified
if ((! $unCharFlag && ! @charList) || ! @regionList) {
$self->showMsgDialogue(
'Reset character visits',
'error',
'No characters and/or regions found',
'ok',
);
return undef;
}
$roomCount = 0;
$deleteCount = 0;
# Deal with non-profile characters
if ($unCharFlag) {
foreach my $regionmapObj (@regionList) {
foreach my $roomNum ($regionmapObj->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
$roomCount++;
foreach my $char ($roomObj->ivKeys('visitHash')) {
my $profObj = $self->session->ivShow('profHash', $char);
if (! $profObj || $profObj->category ne 'char') {
# The character which visited this room no longer exists as a character
# profile
$self->worldModelObj->resetVisitCount(
TRUE, # Update Automapper windows now
$roomObj,
$char,
);
$deleteCount++;
}
}
}
}
# Deal with profile characters
} else {
foreach my $regionmapObj (@regionList) {
foreach my $roomNum ($regionmapObj->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
$roomCount++;
foreach my $char (@charList) {
if ($roomObj->ivExists('visitHash', $char)) {
# Remove this character's visits from the room
$self->worldModelObj->resetVisitCount(
TRUE, # Update Automapper windows now
$roomObj,
$char,
);
$deleteCount++;
}
}
}
}
}
# Show confirmation
return $self->showMsgDialogue(
'Reset character visits',
'info',
'Operation complete (rooms: ' . $roomCount . ', records deleted: ' . $deleteCount . ')',
'ok',
);
}
# Menu 'View' column callbacks
sub changeCharDrawnCallback {
# Called by $self->enableViewColumn
# In GA::Obj::WorldModel->roomInteriorMode 'visit_count', changes which character's visits
# are drawn
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$currentString, $choice, $redrawFlag, $choiceObj,
@profList, @sortedList, @comboList,
%comboHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->changeCharDrawnCallback',
@_,
);
}
# (No standard callback checks for this function)
# Get a sorted list of character profiles, not including the current character (if any)
foreach my $profObj ($self->session->ivValues('profHash')) {
if (
$profObj->category eq 'char'
&& (! $self->session->currentChar || $self->session->currentChar ne $profObj)
) {
push (@profList, $profObj);
}
}
@sortedList = sort {lc($a->name) cmp lc($b->name)} (@profList);
# Prepare a list to show in a combo box. At the same time, compile a hash in the form:
# $hash{combo_box_string} = blessed_reference_of_equivalent_profile
foreach my $profObj (@sortedList) {
push (@comboList, $profObj->name);
$comboHash{$profObj->name} = $profObj;
}
# Add the current character (if there is one) to top of the combo
if ($self->session->currentChar) {
$currentString = '<Use current character>';
unshift (@comboList, $currentString);
}
# Don't prompt for a character, if there are none available
if (! @comboList) {
return $self->showMsgDialogue(
'Select character',
'error',
'There are no character profiles available',
'ok',
);
}
# Prompt the user for a character
$choice = $self->showComboDialogue(
'Select character',
'Select which character\'s visits to draw',
\@comboList,
);
if ($choice) {
if ($choice eq $currentString) {
if (defined $self->showChar) {
$redrawFlag = TRUE;
}
# Use the current character profile (this IV uses the value 'undef' to mean the
# current character)
$self->ivUndef('showChar');
} else {
$choiceObj = $comboHash{$choice};
if (! defined $self->showChar || $self->showChar ne $choiceObj->name) {
$redrawFlag = TRUE;
}
# Use the specified character profile
$self->ivPoke('showChar', $choiceObj->name);
}
# If we are drawing room interiors in 'visit_count' mode, redraw maps to show character
# visits for the selected character (but not if the character hasn't changed)
if ($redrawFlag&& $self->worldModelObj->roomInteriorMode eq 'visit_count') {
$self->drawAllRegions();
}
}
return 1;
}
sub zoomCallback {
# Called by $self->enableViewColumn
# Zooms in or out on the map, for the current region only
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $zoom - Set to 'in' or 'out' for zoom in/zoom out, or set to a number corresponding to
# the new value of GA::Obj::Regionmap->magnification (e.g. 2, 1, 0.5; if set
# to 'undef', the user is prompted for the magnification)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if there is no
# current regionmap, if the standard magnification list is empty or if the user
# declines to specify a magnification, when prompted
# 1 otherwise
my ($self, $zoom, $check) = @_;
# Local variables
my (
$index, $match, $currentMag, $newMag,
@magList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->zoomCallback', @_);
}
# Standard callback check. Import the standard magnification list
@magList = $self->constMagnifyList;
# Perform the check
if (
! $self->currentRegionmap
|| (
defined $zoom
&& (
($zoom eq 'out' && $self->currentRegionmap->magnification <= $magList[0])
|| ($zoom eq 'in' && $self->currentRegionmap->magnification >= $magList[-1])
)
)
) {
return undef;
}
# If the tooltips are visible, hide them
$self->hideTooltips();
# Don't do anything if there is no current regionmap (possible when the user is using the
# mouse scroll button) or when the magnification list is empty (no reason why it should
# be)
if (! $self->currentRegionmap || ! $self->constMagnifyList) {
return undef;
}
# Import the current regionmap's current magnification
$currentMag = $self->currentRegionmap->magnification;
if (defined $zoom && ($zoom eq 'in' || $zoom eq 'out')) {
# The map's current magnification is stored in GA::Obj::Regionmap->magnification. The
# default value is 1
# $self->constMagnifyList contains a standard list of magnifications in ascending order,
# e.g. (0.5, 1, 2)
# If GA::Obj::Regionmap->magnification is in the standard list, then we use the previous
# (or next) value in the list
# Otherwise, we find the previous (or next) value in the list as it would be, if
# GA::Obj::Regionmap->magnification were in it
#
# Try to find GA::Obj::Regionmap->magnification in the standard list, remembering the
# index at which it was found
$index = -1;
OUTER: foreach my $item ($self->constMagnifyList) {
$index++;
if ($magList[$index] == $currentMag) {
$match = $index;
last OUTER;
}
}
if (! defined $match) {
# GA::Obj::Regionmap->magnification isn't a standard value. Insert it into the
# list as long as it's not smaller than the smallest value or bigger than the
# biggest value
# Try inserting it at the beginning...
if ($currentMag < $magList[0]) {
# Use index 0
$match = 0;
# Or at the end...
} elsif ($currentMag > $magList[-1]) {
# Use last index
$match = (scalar @magList) - 1;
# Or somewhere in the middle...
} else {
OUTER: for ($index = 0; $index < ((scalar @magList) - 1); $index++) {
if (
$currentMag > $magList[$index]
&& $currentMag < $magList[($index + 1)]
) {
splice (@magList, ($index + 1), 0, $currentMag);
$match = $index + 1;
last OUTER;
}
}
}
}
# This error message should be impossible...
if (! defined $match) {
return $self->sesion->writeError(
'Error dealing with map magnifications',
$self->_objClass . '->zoomCallback',
);
}
# Now, zoom out (or in), if possible
if ($zoom eq 'out') {
if ($match > 0) {
$match--;
}
} elsif ($zoom eq 'in') {
if ($match < ((scalar @magList) - 1)) {
$match++;
}
}
# Set the new magnification
$newMag = $magList[$match];
} else {
if (! defined $zoom) {
# Prompt the user for a zoom factor
$zoom = $self->showEntryDialogue(
'Enter zoom factor',
'Enter an integer (e.g. 33 for 33% zoom)',
);
# User pressed 'cancel' button
if (! defined $zoom) {
return undef;
# The calling function has supplied a zoom factor. Make sure it's valid
} elsif (! $axmud::CLIENT->floatCheck($zoom, 0) || $zoom == 0) {
return $self->showMsgDialogue(
'Zoom',
'error',
'Illegal magnification \'' . $zoom . '\'% - must be an integer (e.g. 100,'
. ' 50, 200)',
'ok',
);
}
# Convert the zoom factor from a percentage to a number that can be stored in
# GA::Obj::Regionmap->magnification (e.g. convert 133.33% to 1.33)
# $newMag = sprintf('%.2f', ($zoom / 100));
$newMag = Math::Round::nearest(0.01, ($zoom / 100));
} else {
# $zoom is already set to the magnification
$newMag = $zoom;
}
# Make sure the magnification is within limits
if ($newMag < $magList[0] || $newMag > $magList[-1]) {
return $self->showMsgDialogue(
'Zoom',
'error',
'Illegal magnification \'' . $zoom . '\' - use a number in the range '
. int($magList[0] * 100) . '-' . int($magList[-1] * 100). '%',
'ok',
);
}
}
# Set the new magnification; the called function updates every Automapper window using the
# current worldmodel
$self->worldModelObj->setMagnification($self, $newMag);
return 1;
}
sub changeLevelCallback {
# Called by $self->enableViewColumn
# Prompts the user for a new level in the current regionmap, then sets it as the currently-
# displayed level
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $level;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->changeLevelCallback', @_);
}
# (No standard callback checks for this function)
# Prompt the user for a new level
$level = $self->showEntryDialogue(
'Change level',
'Enter the new level number (\'ground\' level is 0)',
);
if (defined $level) {
# Check that $level is a valid integer (positive, negative or 0)
if (! ($level =~ m/^-?\d+$/)) {
return $self->showMsgDialogue(
'Change level',
'error',
'Invalid level \'' . $level . '\' - you must use an integer',
'ok',
);
}
# Set the new current level, which redraws the map
$self->setCurrentLevel($level);
}
return 1;
}
# Menu 'Mode' column callbacks
sub verboseCharsCallback {
# Called by $self->enableModeColumn
# Sets the number of characters at the beginning of a verbose description that are checked
# to match a world model room with the Locator's current room
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $number;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->verboseCharsCallback', @_);
}
# (No standard callback checks for this function)
# Prompt for a new number of verbose characters to match
$number = $self->showEntryDialogue(
'Match verbose description',
'Enter number of initial characters to match (0 = match whole description)',
undef,
$self->worldModelObj->matchDescripCharCount,
);
if ($axmud::CLIENT->intCheck($number, 0)) {
$self->worldModelObj->set_matchDescripCharCount($number);
}
return 1;
}
sub repaintSelectedRoomsCallback {
# Called by $self->enableModeColumn
# 'Repaints' the selected room(s) by copying the values of certain IVs stored in the world
# model's painter object (a non-model GA::ModelObj::Room) to each selected room
#
# 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 (@roomList, @redrawList);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->repaintSelectedRoomsCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Get a list of selected rooms
@roomList = $self->compileSelectedRooms();
foreach my $roomObj (@roomList) {
# Repaint each selected room
$self->paintRoom(
$roomObj,
FALSE, # Don't update Automapper windows yet
);
push (@redrawList, 'room', $roomObj);
}
# Redraw all the selected rooms, so the repainting is visible
$self->worldModelObj->updateMaps(@redrawList);
return 1;
}
sub autoCompareMaxCallback {
# Called by $self->enablemodecolumn
# Sets the maximum number of room comparisons when auto-comparing the Locator task's current
# room with rooms in the world model
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $number;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->autoCompareMaxCallback', @_);
}
# (No standard callback checks for this function)
# Prompt for a new maximum
$number = $self->showEntryDialogue(
'Set limit on room comparisons',
'When comparing the Locator task\'s current room against rooms in the model, set the'
. ' maximum number of rooms to compare (0 - no limit)',
undef,
$self->worldModelObj->autoCompareMax,
);
if ($axmud::CLIENT->intCheck($number, 0)) {
$self->worldModelObj->set_autoCompareMax($number);
}
return 1;
}
sub autoSlideMaxCallback {
# Called by $self->enablemodecolumn
# Sets the maximum distance for auto-slide operations
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $number;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->autoSlideMaxCallback', @_);
}
# (No standard callback checks for this function)
# Prompt for a new maximum
$number = $self->showEntryDialogue(
'Set limit on slide distance',
'When sliding a new room into an unoccupied gridblock, set the maximum slide distance'
. ' (minimum value: 1)',
undef,
$self->worldModelObj->autoSlideMax,
);
if ($axmud::CLIENT->intCheck($number, 1)) {
$self->worldModelObj->set_autoSlideMax($number);
}
return 1;
}
# Menu 'Regions' column callbacks
sub newRegionCallback {
# Called by $self->enableRegionsColumn
# Adds a new region to the world model
#
# Expected arguments
# $tempFlag - If set to TRUE, the new region is a temporary region (that should be
# deleted, the next time the world model is loaded from file)
#
# Return values
# 'undef' on improper arguments, if the new model object can't be created or if the user
# cancels the operation
# 1 otherwise
my ($self, $tempFlag, $check) = @_;
# Local variables
my (
$successFlag, $name, $parentName, $width, $height, $parentNumber, $regionObj, $title,
$regionmapObj,
);
# Check for improper arguments
if (! defined $tempFlag || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->newRegionCallback', @_);
}
# (No standard callback checks for this function)
# Prompt the user for a region name, parent region name and map size
($successFlag, $name, $parentName, $width, $height) = $self->promptNewRegion($tempFlag);
if (! $successFlag) {
# User cancelled the operation
return undef;
} else {
# Check the name is not already in use
if (defined $name && $self->worldModelObj->ivExists('regionmapHash', $name)) {
if ($tempFlag) {
$title = 'New temporary region';
} else {
$title = 'New region';
}
$self->showMsgDialogue(
$title,
'error',
'There is already a region called \'' . $name . '\'',
'ok',
);
return undef;
}
# If a parent was specified, find its world model number
if (defined $parentName) {
$parentNumber = $self->findRegionNum($parentName);
}
# Create the region object
$regionObj = $self->worldModelObj->addRegion(
$self->session,
TRUE, # Update Automapper windows now
$name, # May be an empty string
$parentNumber,
$tempFlag,
);
if (! $regionObj) {
# Operation failed
$self->showMsgDialogue(
'New region',
'error',
'Could not create the new region',
'ok',
);
return undef;
} else {
# Set the new region's size
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $regionObj->name);
$regionmapObj->ivPoke('gridWidthBlocks', $width);
$regionmapObj->ivPoke('gridHeightBlocks', $height);
$regionmapObj->ivPoke('mapWidthPixels', $width * $regionmapObj->blockWidthPixels);
$regionmapObj->ivPoke(
'mapHeightPixels',
$height * $regionmapObj->blockHeightPixels,
);
# Make it the selected region, and draw it on the map
return $self->setCurrentRegion($regionObj->name);
}
}
}
sub renameRegionCallback {
# Called by $self->enableRegionsColumn
# Renames a world model region (and its tied GA::Obj::Regionmap)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if a region with
# the specified name already exists
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $name;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->renameRegionCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Prompt the user for a new region name
$name = $self->showEntryDialogue(
'Change region name',
'Enter a new name for the \'' . $self->currentRegionmap->name . '\' region (max 32'
. ' chars)',
32,
);
if ($name) {
# Check the name is not already in use
if ($self->worldModelObj->ivExists('regionmapHash', $name)) {
$self->showMsgDialogue(
'Change region name',
'error',
'There is already a region called \'' . $name . '\'',
'ok',
);
return undef;
} else {
# Rename the region
$self->worldModelObj->renameRegion($self->currentRegionmap, $name);
}
}
return 1;
}
sub changeRegionParentCallback {
# Called by $self->enableRegionsColumn
# Changes a region's parent region
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the parent
# region can't be set
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$modelNum, $noParentString, $parent, $parentNum,
@list, @sortedList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->changeRegionParentCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Import the world model number of the current region
$modelNum = $self->currentRegionmap->number;
# Get a sorted list of references to world model regions
@list = sort {lc($a->name) cmp lc($b->name)}
($self->worldModelObj->ivValues('regionModelHash'));
# Convert this list into region names, and remove the current region
foreach my $regionObj (@list) {
if ($regionObj->number ne $modelNum) {
push (@sortedList, $regionObj->name);
}
}
# Put an option for 'no parent region' at the top of the list
$noParentString = '<no parent region>';
unshift(@sortedList, $noParentString);
# Prompt the user for a new parent region
$parent = $self->showComboDialogue(
'Change parent region',
'Select the new parent region for \'' . $self->currentRegionmap->name . '\'',
\@sortedList,
);
if ($parent) {
if ($parent eq $noParentString) {
# Set the region to have no parent
if (!
$self->worldModelObj->setParent(
FALSE, # No update
$modelNum,
)
) {
return undef;
}
} else {
$parentNum = $self->findRegionNum($parent);
# Set the new parent region
if (
! $self->worldModelObj->setParent(
FALSE, # No update
$modelNum,
$parentNum,
)
) {
return undef;
}
}
# Redraw the list of regions in the treeview. By using the current region as an
# argument, we make sure that it is visible in the treeview, by expanding the tree
# model as necessary
$self->resetTreeView($self->currentRegionmap->name);
# Make sure the current region is highlighted
$self->treeViewSelectRow($self->currentRegionmap->name);
}
return 1;
}
sub regionFinishedCallback {
# Called by $self->enableRegionsColumn
# Toggles a region's 'finished' status
#
# 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 $regionObj;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->regionFinishedCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Toggle the region, if permitted
$regionObj = $self->worldModelObj->ivShow(
'regionModelHash',
$self->currentRegionmap->number,
);
if ($regionObj->tempRegionFlag) {
$self->showMsgDialogue(
'Set finished region',
'error',
'Temporary regions can\'t be marked finished',
'ok',
);
} else {
$regionObj->toggleFinished();
$self->treeViewUpdateRow($regionObj->name);
}
return 1;
}
sub addRegionSchemeCallback {
# Called by $self->enableRegionsColumn
# Attach a new region scheme
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the region
# scheme can't be added
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $choice;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->attachRegionSchemeCallback',
@_,
);
}
# (No standard callback check)
# Prompt the user for the name of the new colour scheme
$choice = $self->showEntryDialogue(
'Add region colour scheme',
'Enter a name for the new colour scheme (max 16 chars)',
16, # Maximum characters
);
if (defined $choice) {
if ($self->worldModelObj->ivExists('regionSchemeHash', $choice)) {
$self->showMsgDialogue(
'Add region colour scheme',
'error',
'There is already a region colour scheme called \'' . $choice . '\'',
'ok',
);
} else {
$self->worldModelObj->addRegionScheme($self->session, $choice);
$self->showMsgDialogue(
'Add region colour scheme',
'info',
'Added the region colour scheme \'' . $choice . '\'',
'ok',
);
return 1;
}
}
return undef;
}
sub doRegionSchemeCallback {
# Called by $self->enableRegionsColumn
# Edits, renames or deletes a region scheme
#
# Expected arguments
# $type - 'edit' to edit a region scheme, 'rename' to rename it, or 'delete' to
# delete it
# Optional arguments
# $regionmapObj - If specified, manipulate the region scheme attached to this regionmap.
# Otherwise, prompt the user for a region scheme
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the region
# scheme can't be manipulated
# 1 otherwise
my ($self, $type, $regionmapObj, $check) = @_;
# Local variables
my (
$choice, $choice2,
@list, @sortedList,
);
# Check for improper arguments
if (
! defined $type || ($type ne 'edit' && $type ne 'rename' && $type ne 'delete')
|| defined $check
) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->doRegionSchemeCallback',
@_,
);
}
# (No standard callback check)
if (! $regionmapObj) {
# Prompt the user for an existing colour scheme. Remove 'default' if renaming/deleting
foreach my $name ($self->worldModelObj->ivKeys('regionSchemeHash')) {
if ($type eq 'edit' || $name ne 'default') {
push (@list, $name);
}
}
@sortedList = sort {lc($a) cmp lc($b)} (@list);
$choice = $self->showComboDialogue(
ucfirst($type) . ' region colour scheme',
'Select the colour scheme to ' . $type,
\@sortedList,
);
} else {
if (! defined $regionmapObj->regionScheme) {
$choice = 'default';
} else {
$choice = $regionmapObj->regionScheme;
}
}
if (defined $choice) {
if ($type eq 'edit') {
# Open up an 'edit' window to edit the object
$self->createFreeWin(
'Games::Axmud::EditWin::RegionScheme',
$self,
$self->session,
'Edit region colour scheme \'' . $choice . '\'',
$self->worldModelObj->ivShow('regionSchemeHash', $choice),
FALSE, # Not temporary
);
return 1;
} elsif ($type eq 'rename') {
# Prompt the user for the new name
$choice2 = $self->showEntryDialogue(
'Rename region colour scheme',
'Enter a new name for the colour scheme (max 16 chars)',
16, # Maximum characters
);
if (
defined $choice2
&& $self->worldModelObj->renameRegionScheme($self->session, $choice, $choice2)
) {
$self->showMsgDialogue(
ucfirst($type) . ' region colour scheme',
'info',
'Renamed \'' . $choice . '\' to \'' . $choice2 . '\'',
'ok',
);
return 1;
}
} else {
# Delete the region scheme, and redraw regions in affected automapper windows
$self->worldModelObj->deleteRegionScheme(TRUE, $choice);
$self->showMsgDialogue(
ucfirst($type) . ' region colour scheme',
'info',
'Deleted \'' . $choice . '\'',
'ok',
);
}
}
return undef;
}
sub attachRegionSchemeCallback {
# Called by $self->enableRegionsColumn
# Attach a region scheme to the current regionmap
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the region
# scheme can't be attached
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$choice,
@list, @sortedList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->attachRegionSchemeCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || $self->worldModelObj->ivPairs('regionSchemeHash') < 2) {
return undef;
}
# Prompt the user for a colour scheme to attach. Don't show the currently attached colour
# scheme (if any)
foreach my $schemeObj ($self->worldModelObj->ivValues('regionSchemeHash')) {
if (
(
! defined $self->currentRegionmap->regionScheme
&& $schemeObj ne $self->worldModelObj->defaultSchemeObj
) || (
defined $self->currentRegionmap->regionScheme
&& $self->currentRegionmap->regionScheme ne $schemeObj->name
)
) {
push (@list, $schemeObj->name);
}
}
@sortedList = sort {lc($a) cmp lc($b)} (@list);
$choice = $self->showComboDialogue(
'Attach region colour scheme',
'Select the colour scheme to attach to \'' . $self->currentRegionmap->name . '\'',
\@sortedList,
);
if ($choice) {
$self->worldModelObj->attachRegionScheme(
TRUE, # Update automapper windows
$choice,
$self->currentRegionmap->name,
);
}
return 1;
}
sub detachRegionSchemeCallback {
# Called by $self->enableRegionsColumn
# Detaches a region scheme from the current regionmap
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the region
# scheme can't be detached
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->detachRegionSchemeCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! defined $self->currentRegionmap->regionScheme) {
return undef;
}
# Detach the region scheme
$self->worldModelObj->detachRegionScheme(
TRUE, # Update automapper windows
$self->currentRegionmap->name,
);
return 1;
}
sub convertRegionExitCallback {
# Called by $self->enableRegionsColumn
# Converts all region exits in the region into super-region exits (or deconverts all super-
# region exits into normal region exits)
#
# Expected arguments
# $convertFlag - TRUE if converting region exits to super-region exits, FALSE if
# deconverting super-region exits into region exits
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if there are no
# exits to convert (or deconvert)
# 1 otherwise
my ($self, $convertFlag, $check) = @_;
# Local variables
my (
$title, $msg,
@list, @twinList,
);
# Check for improper arguments
if (! defined $convertFlag || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->changeRegionParentCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
if ($convertFlag) {
$title = 'Convert region exits';
# Get a list of (normal) super region exits
foreach my $exitNum ($self->currentRegionmap->ivKeys('regionExitHash')) {
my ($exitObj, $twinExitObj);
$exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
if ($exitObj->regionFlag && ! $exitObj->superFlag) {
push (@list, $exitObj);
# Also convert the twin exit, if there is one
if ($exitObj->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow(
'exitModelHash',
$exitObj->twinExit,
);
if ($twinExitObj->regionFlag && ! $twinExitObj->superFlag) {
push (@twinList, $twinExitObj);
}
}
}
}
if (! @list) {
# Display the 'dialogue' window
$self->showMsgDialogue(
$title,
'error',
'There are no (normal) region exits in this region',
'ok',
);
return undef;
}
# Convert the exits
foreach my $exitObj (@list, @twinList) {
# Mark the exit as a super-region exit, and instruct the world model to update its
# automapper windows
$self->worldModelObj->setSuperRegionExit(
$self->session,
TRUE, # Update Automapper windows now
$exitObj,
FALSE, # Not an exclusive super-region exit
);
}
# Let the world model process any necessary changes
$self->worldModelObj->updateRegionPaths($self->session);
# Prepare the confirmation to display. Show the number of exits in the current region
# converted, not the total number (including all of their twin exits)
if ((scalar @list) == 1) {
$msg = 'Converted 1 region exit into a super-region exit';
} else {
$msg = 'Converted ' . (scalar @list) . ' region exits into super-region exits';
}
} else {
$title = 'Deconvert super-region exits';
# Get a list of super region exits
foreach my $exitNum ($self->currentRegionmap->ivKeys('regionExitHash')) {
my ($exitObj, $twinExitObj);
$exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
if ($exitObj->regionFlag && $exitObj->superFlag) {
push (@list, $exitObj);
# Also deconvert the twin exit, if there is one
if ($exitObj->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow(
'exitModelHash',
$exitObj->twinExit,
);
if ($twinExitObj->regionFlag && $twinExitObj->superFlag) {
push (@twinList, $twinExitObj);
}
}
}
}
if (! @list) {
# Display the 'dialogue' window
$self->showMsgDialogue(
$title,
'error',
'There are no super-region exits in this region',
'ok',
);
return undef;
}
# Deconvert the exits
foreach my $exitObj (@list, @twinList) {
# Mark the exit as a normal region exit, and instruct the world model to update its
# automapper windows
$self->worldModelObj->restoreSuperRegionExit(
TRUE, # Update Automapper windows now
$exitObj,
);
}
# Let the world model process any necessary changes
$self->worldModelObj->updateRegionPaths($self->session);
# Prepare the confirmation to display. Show the number of exits in the current region
# converted, not the total number (including all of their twin exits)
if ((scalar @list) == 1) {
$msg = 'Deonverted 1 super-region exit into a normal region exit';
} else {
$msg = 'Deconverted ' . (scalar @list)
. ' super-region exits into normal region exits';
}
}
# Show a confirmation
$self->showMsgDialogue(
$title,
'info',
$msg,
'ok',
);
return 1;
}
sub identifyRegionCallback {
# Called by $self->enableRegionsColumn
# Identifies the currently highlighted region (in the treeview)
#
# 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 ($text, $regionObj, $parentObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->identifyRegionCallback', @_);
}
# Standard callback check
if (! $self->treeViewSelectedLine) {
return undef;
}
# Prepare the text to display
$text = 'Currently highlighted region: \'' . $self->treeViewSelectedLine . '\'';
$regionObj = $self->findRegionObj($self->treeViewSelectedLine);
$text .= ' (#' . $regionObj->number . ')';
if ($regionObj->parent) {
$parentObj = $self->worldModelObj->ivShow('modelHash', $regionObj->parent);
$text .= "\nParent region: \'" . $parentObj->name . '\' (#' . $parentObj->number . ')';
}
# Display the 'dialogue' window
$self->showMsgDialogue(
'Highlighted region',
'info',
$text,
'ok',
undef,
TRUE, # Preserve newline characters in $text
);
return 1;
}
sub editRegionCallback {
# Called by $self->enableRegionsColumn
# Opens a GA::EditWin::ModelObj::Region for the current region
#
# 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 ($number, $obj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->editRegionCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Find the current regionmap's equivalent world model object
$number = $self->currentRegionmap->number;
if ($number) {
$obj = $self->worldModelObj->ivShow('modelHash', $number);
# Open up an 'edit' window to edit the object
$self->createFreeWin(
'Games::Axmud::EditWin::ModelObj::Region',
$self,
$self->session,
'Edit ' . $obj->category . ' model object #' . $obj->number,
$obj,
FALSE, # Not temporary
);
}
return 1;
}
sub regionScreenshotCallback {
# Called by $self->enableRegionsColumn
# Takes a screenshot of a portion of the regionmap (or the whole regionmap), at the
# currently displayed level, and saves it in the ../screenshots directory
#
# Expected arguments
# $type - 'visible' for the visible portion of the canvas, 'occupied' for the
# occupied portion of the canvas, and 'whole' for the whole canvas
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# declines to take the screenshot after a warning
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$xOffset, $yOffset, $xPos, $yPos, $left, $top, $right, $bottom, $width, $height, $msg,
$result, $file, $path, $count,
);
# Check for improper arguments
if (! defined $type || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->regionScreenshotCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# The menu column is presumably still open - which will get in the way of the screenshot.
# Give it a chance to close
$axmud::CLIENT->desktopObj->updateWidgets(
$self->_objClass . '->regionScreenshotCallback',
);
if ($type eq 'visible') {
# Find the position of the top-left corner of the visible canvas
($xOffset, $yOffset, $xPos, $yPos) = $self->getMapPosn();
$left = int($self->currentRegionmap->mapWidthPixels * $xPos);
$top = int($self->currentRegionmap->mapHeightPixels * $yPos);
# Import the size of the visible canvas
$width = $self->canvasScrollerWidth;
$height = $self->canvasScrollerHeight;
} elsif ($type eq 'occupied') {
# Find the extent of the occupied map, in pixels
($left, $right, $top, $bottom) = $self->findOccupiedMap();
$width = $right - $left + 1;
$height = $bottom - $top + 1;
} else {
# Import the size of the whole canvas
$width = $self->currentRegionmap->mapWidthPixels;
$height = $self->currentRegionmap->mapHeightPixels;
}
# For very large screenshots, display a warning before starting the operation
if ($width * $height > 100_000_000) {
$msg = 'This operation will produce a very large image (' . $width . 'x' . $height
. ' pixels). ' . 'Are you sure you want to continue?';
$result = $self->showMsgDialogue(
'Screenshot',
'warning',
$msg,
'yes-no',
);
if ($result ne 'yes') {
return undef;
}
}
# For large-ish screenshots, show the pause window
if ($width * $height > 5_000_000) {
$self->showPauseWin();
}
# Take the screenshot
my $surface = Cairo::ImageSurface->create('rgb24', $width, $height);
my $cr = Cairo::Context->create($surface);
$cr->rectangle(0, 0, $width, $height);
$cr->set_source_rgb(1, 1, 1);
$cr->fill();
if ($type eq 'visible' || $type eq 'occupied') {
$cr->translate(-$left, -$top);
}
$self->canvas->render($cr, undef, 1);
my $loader = Gtk3::Gdk::PixbufLoader->new();
$surface->write_to_png_stream (
sub {
my ($loader, $buffer) = @_;
$loader->write([map ord, split //, $buffer]);
return TRUE;
},
$loader,
);
$loader->close();
my $pixbuf = $loader->get_pixbuf();
$file = $self->currentRegionmap->name . '_level_' . $self->currentRegionmap->currentLevel;
$path = $axmud::DATA_DIR . '/screenshots/' . $file . '.png';
# If the file $path already exists, add a postscript to create a filepath that doesn't yet
# exist
if (-e $path) {
$count = 0;
do {
$count++;
my $newFile = $file . '_(' . $count . ')';
$path = $axmud::DATA_DIR . '/screenshots/' . $newFile . '.png';
} until (! -e $path);
}
# Save the file as a .jpeg
$pixbuf->save($path, 'png');
# Make the pause window invisible
$self->hidePauseWin();
# Display a confirmation dialogue
$self->showMsgDialogue(
'Screenshot',
'info',
'Screenshot saved to ' . $path,
'ok',
);
return 1;
}
sub removeRoomFlagsCallback {
# Called by $self->enableRegionsColumn
# Prompts the user to select a room flag to be removed from every room in the current region
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user doesn't
# select a room flag, if the region has no rooms or if every room in the region has no
# room flags
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$choice, $msg, $count,
@list, @sortedList, @nameList,
%flagHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->removeRoomFlagsCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Check there are some rooms in the current region
if (! $self->currentRegionmap->gridRoomHash) {
$self->showMsgDialogue(
'Remove room flags',
'error',
'There are no rooms in the current region',
'ok',
);
return undef;
}
# Go through every room in the region, compiling a list of room flags actually in use
foreach my $roomNum ($self->currentRegionmap->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
foreach my $flag ($roomObj->ivKeys('roomFlagHash')) {
# Compile a hash containing one entry for each room flag used (regardless of whether
# it's used in one room or multiple rooms)
$flagHash{$flag} = undef;
}
}
if (! %flagHash) {
$self->showMsgDialogue(
'Remove room flags',
'error',
'No rooms in the current region are using room flags',
'ok',
);
return undef;
}
# Get a list of the room flags in use, sorted by priority
foreach my $roomFlag (keys %flagHash) {
my $roomFlagObj = $self->worldModelObj->ivShow('roomFlagHash', $roomFlag);
if ($roomFlagObj) {
push (@list, $roomFlagObj);
}
}
@sortedList = sort {$a->priority <=> $b->priority} (@list);
foreach my $roomFlagObj (@sortedList) {
push (@nameList, $roomFlagObj->name);
}
# Prompt the user to select one of the room flags
$choice = $self->showComboDialogue(
'Remove room flags',
'Select which room flag should be removed from every room in this region',
\@nameList,
);
if (! $choice) {
return undef;
} else {
# Remove the room flag from each room in turn
$count = $self->worldModelObj->removeRoomFlagInRegion($self->currentRegionmap, $choice);
# Display a confirmation message
$msg = 'Room flag \'' . $choice . '\' removed from ';
if ($count == 1) {
$msg .= '1 room in this region',
} else {
$msg .= $count . ' rooms in this region',
}
$self->showMsgDialogue(
'Remove room flags',
'info',
$msg,
'ok',
);
return 1;
}
}
sub preDrawSizeCallback {
# Called by $self->enableRegionsColumn
# Prompts the user to set the minimum size for regions that should be pre-drawn when the
# automapper window opens
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the user declines to modify the current value
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $choice;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->preDrawSizeCallback', @_);
}
# (No standard callback check)
# Prompt the user
$choice = $self->showEntryDialogue(
'Pre-drawn regions',
'Set the minimum size (in rooms) of any regions that should be pre-drawn when the'
. ' Automapper window opens (or use 0 to pre-draw all regions)',
undef, # No maximum characters
$self->worldModelObj->preDrawMinRooms,
);
if (defined $choice && $axmud::CLIENT->intCheck($choice, 0)) {
$self->worldModelObj->set_preDrawMinRooms($choice);
}
return 1;
}
sub preDrawRetainCallback {
# Called by $self->enableRegionsColumn
# Prompts the user to set the minimum size for drawn parchments that should be retained in
# memory when a new current region is set
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the user declines to modify the current value
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $choice;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->preDrawRetainCallback', @_);
}
# (No standard callback check)
# Prompt the user
$choice = $self->showEntryDialogue(
'Retain drawn regions',
'Set the minimum size (in rooms) of any regions that should be retained in memory when'
. ' they\'re not visible (or use 0 to retain all drawn regions)',
undef, # No maximum characters
$self->worldModelObj->preDrawRetainRooms,
);
if (defined $choice && $axmud::CLIENT->intCheck($choice, 0)) {
$self->worldModelObj->set_preDrawRetainRooms($choice);
}
return 1;
}
sub preDrawSpeedCallback {
# Called by $self->enableRegionsColumn
# Prompts the user to set the (approximate) percentage of available processor time to be
# spent on pre-drawing operations
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the user declines to modify the current value
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $choice;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->preDrawSpeedCallback', @_);
}
# (No standard callback check)
# Prompt the user
$choice = $self->showEntryDialogue(
'Pre-drawing speed',
'Set the approximate percentage of processor time that should be spent on pre-drawing'
. ' maps (use a value in the range 1-100)',
undef, # No maximum characters
$self->worldModelObj->preDrawAllocation,
);
if (defined $choice && $axmud::CLIENT->intCheck($choice, 1, 100)) {
$self->worldModelObj->set_preDrawAllocation($choice);
}
return 1;
}
sub redrawRegionsCallback {
# Called by $self->enableRegionsColumn
# Prompts the user to confirm that all drawn regions should be redrawn, then performs the
# operation
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the user declines to modify the current value
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $choice;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->redrawRegionsCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Prompt the user
$choice = $self->showMsgDialogue(
'Redraw drawn regions',
'question',
'This operation can reduce performance, perhaps for several minutes. Are you sure you'
. ' want to proceed?',
'yes-no',
);
if (defined $choice && $choice eq 'yes') {
$self->redrawRegions();
}
}
sub recalculatePathsCallback {
# Called by $self->enableRegionsColumn
# Recalculates region paths - paths between each room in the region which has a super-region
# exit, and every other room in the region which has a super-region exit (used for quick
# pathfinding across different regions)
#
# Expected arguments
# $type - Which region to process: 'current' for the current regionmap, 'select' to
# prompt the user for a regionmap, 'all' to recalculate paths in all
# regionmaps, or 'exit' to recalculate region paths to and from the
# selected exit (only)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# declines to specify a region
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$choice, $count, $estimate, $msg,
@nameList, @regionmapList,
);
# Check for improper arguments
if (
! defined $type
|| ($type ne 'current' && $type ne 'select' && $type ne 'all' && $type ne 'exit')
|| defined $check
) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->recalculatePathsCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ($type eq 'current' && ! $self->currentRegionmap->gridRoomHash)
|| ($type eq 'exit' && ! $self->selectedExit && ! $self->selectedExit->superFlag)
) {
return undef;
}
# Recalculate paths in the current region
if ($type eq 'current') {
push (@regionmapList, $self->currentRegionmap);
# Recalculate paths in a region specified by the user
} elsif ($type eq 'select') {
# Get a sorted list of references to world model regions
@nameList = sort {lc($a) cmp lc($b)} ($self->worldModelObj->ivKeys('regionmapHash'));
# Prompt the user for a region name
$choice = $self->showComboDialogue(
'Recalculate region paths',
'Select the region whose paths should be recalculated',
\@nameList,
);
if (! $choice) {
return undef;
} else {
push (@regionmapList, $self->worldModelObj->ivShow('regionmapHash', $choice));
}
# Recalculate paths in all regions
} elsif ($type eq 'all') {
# For a large world model, prompt the user for confirmation
if ($self->worldModelObj->modelActualCount > 3000) {
$choice = $self->showMsgDialogue(
'Recalculate region paths',
'question',
'The operation to recalculate region paths across all regions may take some'
. ' time. Are you sure you want to continue?',
'yes-no',
);
if (! defined $choice || $choice ne 'yes') {
return undef;
}
}
# Compile a list of regionmaps
@regionmapList = $self->worldModelObj->ivValues('regionmapHash');
}
if ($type ne 'exit') {
# Work out how many region paths there are likely to be
$estimate = 0;
foreach my $regionmapObj (@regionmapList) {
my $exitCount = 0;
# Count the number of super-region exits
foreach my $exitNum ($regionmapObj->regionExitHash) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
if ($exitObj->superFlag) {
$exitCount++;
}
}
# If there are ten super-region exits, each individual exit has nine region paths
# joining it to every other super-region exit. We then double the number, because
# safe region paths are stored separately. So the estimated number of region
# paths is ((n-1) ^ 2 ), all multiplied by 2
$estimate += (2 * (($exitCount - 1) ** 2));
}
# If the estimated number of paths is above the limit set by the world model, make the
# pause window visible for the duration of the recalculation
if ($estimate > $self->worldModelObj->recalculatePauseNum) {
$self->showPauseWin();
}
# Recalculate region paths for each region added to our list
$count = 0;
foreach my $regionmapObj (@regionmapList) {
my $number = $self->worldModelObj->recalculateRegionPaths(
$self->session,
$regionmapObj,
);
if ($number) {
$count += $number;
}
}
# Make the pause window invisible
$self->hidePauseWin();
} else {
# Recalculate paths to/from the selected exit.
$count = $self->worldModelObj->recalculateSpecificPaths(
$self->session,
$self->currentRegionmap,
$self->selectedExit,
);
# In case the called function returns 'undef', $count still needs to be an integer
if (! $count) {
$count = 0;
}
# For the message we're about to compose, @regionmapList must contain the affected
# regionmap
push (@regionmapList, $self->currentRegionmap);
}
# Display a popup showing the results
$msg = 'Recalculation complete: ';
if (! $count) {
$msg .= 'no region paths found';
} elsif ($count == 1) {
$msg .= '1 region path found';
} else {
$msg .= $count . ' region paths found';
}
if (@regionmapList == 1) {
$msg .= ' in 1 region.';
} else {
$msg .= ' in ' . scalar @regionmapList . ' regions.';
}
$self->showMsgDialogue(
'Recalculate region paths',
'info',
$msg,
'ok',
);
return 1;
}
sub locateCurrentRoomCallback {
# Called by $self->enableRegionsColumn
# Tries to find the current room by comparing the Locator task's current room with every
# room in the current region, in a specified region, or in all regions
# If there's a single matching room, that room is set as the current room. If the single
# matching room is in a different region or level to the current one, the map is redrawn
# If there are multiple matching rooms, those rooms are selected. If they are all in a
# different region or at a different level to the current one, the map is redrawn
#
# Expected arguments
# $type - Where to search: 'current' for the current regionmap, 'select' to prompt the
# user for a regionmap, or 'all' to search in all regionmaps
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if there is no
# current regionmap, or if there is no Locator task (or the task doesn't know the
# current location), if the Locator's current room is dark or unspecified or if the
# user declines to continue
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$taskObj, $msg, $regionName, $regionmapObj, $choice, $matchObj, $regionObj,
@roomList, @list, @regionList, @selectList, @modList, @newRegionList, @sortedList,
%regionmapHash,
);
# Check for improper arguments
if (
! defined $type || ($type ne 'current' && $type ne 'select' && $type ne 'all')
|| defined $check
) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->locateCurrentRoomCallback',
@_,
);
}
# Standard callback check
if ($type eq 'current' && ! $self->currentRegionmap->gridRoomHash) {
return undef;
}
# Import the Locator task
$taskObj = $self->session->locatorTask;
# If there is no Locator task, or if it doesn't know its location, display a warning
if (! $taskObj || ! $taskObj->roomObj) {
$msg = 'the Locator task isn\'t ready';
# Also display a warning if the Locator's current room is dark or unspecified
} elsif ($taskObj->roomObj->currentlyDarkFlag) {
$msg = 'it is dark';
} elsif ($taskObj->roomObj->unspecifiedFlag) {
$msg = 'it is an unspecified room';
}
if ($msg) {
$self->showMsgDialogue(
'Locate current room',
'error',
'Can\'t locate the current room because ' . $msg,
'ok',
);
return undef;
}
# Compile a list of rooms to search
# Get rooms in the current region
if ($type eq 'current') {
# Get a list of rooms in the current region
@roomList = $self->currentRegionmap->ivValues('gridRoomHash');
# Get rooms in a region specified by the user
} elsif ($type eq 'select') {
# Get a sorted list of references to world model regions
@list = sort {lc($a->name) cmp lc($b->name)}
($self->worldModelObj->ivValues('regionModelHash'));
# Convert this list into region names
foreach my $regionObj (@list) {
push (@regionList, $regionObj->name);
}
# Prompt the user for a region name
$regionName = $self->showComboDialogue(
'Select region',
'Select the region in which to search',
\@regionList,
);
if (! $regionName) {
return undef;
}
# Find the matching regionmap
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $regionName);
if (! $regionmapObj) {
return undef;
}
# Get a list of rooms in the specified region
@roomList = $regionmapObj->ivValues('gridRoomHash');
# Locate rooms in all regions
} elsif ($type eq 'all') {
# Get a list of rooms in all regions
@roomList = $self->worldModelObj->ivKeys('roomModelHash');
}
# If a room limit is set, prompt the user for confirmation
if (
$self->worldModelObj->locateMaxObjects
&& $self->worldModelObj->locateMaxObjects < @roomList
) {
$choice = $self->showMsgDialogue(
'Locate current room',
'question',
'There are ' . scalar @roomList . ' rooms to search. Do you want to continue?',
'yes-no',
);
if ($choice ne 'yes') {
return undef;
}
}
# Compare the Locator task's current room with every room in @roomList
foreach my $roomNum (@roomList) {
my ($roomObj, $result);
$roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
($result) = $self->worldModelObj->compareRooms($self->session, $roomObj);
if ($result) {
push (@selectList, $roomObj);
# Add the parent region to a hash so we can quickly check how many regions
# have matching rooms
$regionmapHash{$roomObj->parent} = undef;
}
}
# No matching rooms found
if (! @selectList) {
# Show a confirmation
if ($type eq 'current') {
$msg = 'No matching rooms found in the current region';
} elsif ($type eq 'select') {
$msg = 'No matching rooms found in the \'' . $regionmapObj->name . '\' region';
} elsif ($type eq 'all') {
$msg = 'No matching rooms found in any region';
}
$self->showMsgDialogue(
'Locate current room',
'error',
$msg,
'ok',
);
# A single matching room found
} elsif (@selectList == 1) {
# To clear a previous location attempt, in which many rooms were selected, unselect any
# existing selected objects
$self->setSelectedObj();
# Mark the matching room as the automapper's current room. If it's in a different
# regionmap (or on a different level), the map is redrawn
$self->mapObj->setCurrentRoom($selectList[0]);
# Show a confirmation
$self->showMsgDialogue(
'Locate current room',
'info',
'1 matching room found; current location set to room #'
. $self->mapObj->currentRoom->number,
'ok',
);
# Multiple matching rooms were found
} else {
# Unselect any existing selected objects
$self->setSelectedObj();
# Select all of the matching rooms. $self->setSelectedObj expects a list in the form
# (room_object, 'room', room_object, 'room', ...)
foreach my $roomObj (@selectList) {
push (@modList, $roomObj, 'room');
}
$self->setSelectedObj(
\@modList,
TRUE, # Select multiple objects
);
# Get a sorted list of affected regions
foreach my $number (keys %regionmapHash) {
my $regionObj = $self->worldModelObj->ivShow('modelHash', $number);
push (@newRegionList, $regionObj->name);
}
@sortedList = sort {lc($a) cmp lc($b)} (@newRegionList);
# Show a confirmation
$msg = scalar @selectList . ' matching rooms found in ';
if ($type eq 'all') {
if (@sortedList > 1) {
$msg .= scalar @sortedList . " regions:\n";
# Sort the region names alphabetically
foreach my $item (@sortedList) {
$msg .= '\'' . $item . '\' ';
}
} else {
$msg .= 'the region \'' . $sortedList[0] . '\'';
}
} elsif ($type eq 'select') {
$msg .= 'the region \'' . $regionName . '\'';
} else {
$msg .= 'this region';
}
$self->showMsgDialogue(
'Locate current room',
'info',
$msg,
'ok',
);
# Check the list of selected rooms, looking for the first one that's in the current
# region
OUTER: foreach my $roomObj (@selectList) {
if ($roomObj->parent eq $self->currentRegionmap->number) {
$matchObj = $roomObj;
last OUTER;
}
}
if (! $matchObj) {
# None of the selected rooms are in the current region. Use the first selected
# room...
$matchObj = $selectList[0];
# ...and change the current region to show that room
$regionObj = $self->worldModelObj->ivShow('modelHash', $matchObj->parent);
$self->setCurrentRegion($regionObj->name);
}
# Centre the map over the chosen selected room
$self->centreMapOverRoom($matchObj);
}
return 1;
}
sub removeBGColourCallback {
# Called by $self->enableRegionsColumn
# Empties an existing region of any coloured blocks and rectangles matching a colour
# specified by the user
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$choice,
@comboList, @squareList, @rectList,
%colourHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->removeBGColourCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Get a list of all coloured blocks in the region
@squareList = $self->currentRegionmap->ivKeys('gridColourBlockHash');
# Get a list of all coloured rectangles in the region
@rectList = $self->currentRegionmap->ivValues('gridColourObjHash');
if (@squareList || @rectList) {
# Compile a hash of RGB colours in use with coloured squares and rectangles, so we can
# eliminate duplicates
foreach my $colour ($self->currentRegionmap->ivValues('gridColourBlockHash')) {
$colourHash{uc($colour)} = undef;
}
foreach my $obj (@rectList) {
$colourHash{uc($obj->colour)} = undef;
}
# Sort into some kind of order
@comboList = sort {$a cmp $b} (keys %colourHash);
# Prompt the user
$choice = $self->showComboDialogue(
'Remove background colour',
'Choose a colour to remove from those used on the map background to remove',
\@comboList,
);
if (defined $choice) {
foreach my $coord (@squareList) {
if ($self->currentRegionmap->ivShow('gridColourBlockHash', $coord) eq $choice) {
# $coord can be in the form 'x_y_z' or 'x_y'; in either case, we don't
# want the z
my ($x, $y) = split (/_/, $coord);
$self->currentRegionmap->removeSquare($coord);
$self->deleteCanvasObj(
'square',
$x . '_' . $y,
$self->currentRegionmap,
$self->currentParchment,
);
}
}
foreach my $obj (@rectList) {
if ($obj->colour eq $choice) {
$self->currentRegionmap->removeRect($obj);
$self->deleteCanvasObj(
'rect',
$obj->number,
$self->currentRegionmap,
$self->currentParchment,
);
}
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
}
}
return 1;
}
sub removeBGAllCallback {
# Called by $self->enableRegionsColumn
# Empties an existing region of its coloured blocks and rectangles
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$choice,
@squareList, @rectList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->removeBGAllCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Get a list of all coloured blocks in the region
@squareList = $self->currentRegionmap->ivKeys('gridColourBlockHash');
# Get a list of all coloured rectangles in the region
@rectList = $self->currentRegionmap->ivValues('gridColourObjHash');
# Prompt the user before removing anything
if (@squareList || @rectList) {
$choice = $self->showMsgDialogue(
'Remove background colours',
'question',
'Are you sure you want to remove all background colours in this region?',
'yes-no',
);
if (defined $choice && $choice eq 'yes') {
foreach my $coord (@squareList) {
# $coord can be in the form 'x_y_z' or 'x_y'; in either case, we don't
# want the z
my ($x, $y) = split (/_/, $coord);
$self->currentRegionmap->removeSquare($coord);
$self->deleteCanvasObj(
'square',
$x . '_' . $y,
$self->currentRegionmap,
$self->currentParchment,
);
}
foreach my $obj (@rectList) {
$self->currentRegionmap->removeRect($obj);
$self->deleteCanvasObj(
'rect',
$obj->number,
$self->currentRegionmap,
$self->currentParchment,
);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
}
}
return 1;
}
sub emptyRegionCallback {
# Called by $self->enableRegionsColumn
# Empties an existing region of its rooms
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the region is
# already empty or if the user declines to continue, when prompted
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$regionObj, $msg, $result,
@roomList, @otherList, @labelList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->emptyRegionCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Get the region object corresponding to the current regionmap
$regionObj = $self->worldModelObj->ivShow('modelHash', $self->currentRegionmap->number);
# Get a list of the region's child objects, but don't include any child regions (which won't
# be deleted)
foreach my $childNum ($regionObj->ivKeys('childHash')) {
my $childObj = $self->worldModelObj->ivShow('modelHash', $childNum);
if ($childObj->category eq 'room') {
push (@roomList, $childObj);
} elsif ($childObj->category ne 'region') {
push (@otherList, $childObj);
}
}
# Get a list of the regionmap's labels
@labelList = $self->currentRegionmap->ivValues('gridLabelHash');
if (! @roomList && ! @otherList && ! @labelList) {
$self->showMsgDialogue(
'Empty region',
'error',
'The current region doesn\'t contain any rooms, model objects or labels',
'ok',
);
return undef;
} else {
# Give the user a chance to change their minds, before emptying the region
$msg = "Are you sure you want to empty the\n\'" . $regionObj->name
. "\'? region? It contains:\n\n Rooms: " . scalar @roomList
. "\n Other model objects: " . scalar @otherList
. "\n Labels: " . scalar @labelList;
$result = $self->showMsgDialogue(
'Empty region',
'question',
$msg,
'yes-no',
undef,
TRUE, # Preserve newline characters in $msg
);
if ($result ne 'yes') {
return undef;
} else {
# Show a pause window, if necessary. The call to ->redrawRegions below will turn it
# off again
if ((scalar @roomList) > 200) {
# If the tooltips are visible, hide them
$self->hideTooltips();
# Show the pause window
$self->showPauseWin();
}
# Empty the region
$self->worldModelObj->emptyRegion(
$self->session,
FALSE,
$regionObj,
);
# Redraw the empty region
$self->redrawRegions(
$self->worldModelObj->ivShow('regionmapHash', $regionObj->name),
TRUE, # Only redraw this region
);
return 1;
}
}
}
sub deleteRegionCallback {
# Called by $self->enableRegionsColumn
# Deletes the current region
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# declines to continue, when prompted
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$regionObj, $msg, $result, $total,
@roomList, @otherList, @labelList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->deleteRegionCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Get the region object corresponding to the current regionmap
$regionObj = $self->worldModelObj->ivShow('modelHash', $self->currentRegionmap->number);
# Get a list of the region's child objects, but don't include any child regions (which won't
# be deleted)
foreach my $childNum ($regionObj->ivKeys('childHash')) {
my $childObj = $self->worldModelObj->ivShow('modelHash', $childNum);
if ($childObj->category eq 'room') {
push (@roomList, $childObj);
} elsif ($childObj->category ne 'region') {
push (@otherList, $childObj);
}
}
# Get a list of the regionmap's labels
@labelList = $self->currentRegionmap->ivValues('gridLabelHash');
if (@roomList || @otherList || @labelList) {
# Give the user a chance to change their minds, before emptying the region
$msg = "Are you sure you want to delete the\n\'" . $regionObj->name
. "\' region? It contains:\n\n Rooms: " . scalar @roomList
. "\n Other model objects: " . scalar @otherList
. "\n Labels: " . scalar @labelList;
$result = $self->showMsgDialogue(
'Delete region',
'question',
$msg,
'yes-no',
undef,
TRUE, # Preserve newline characters in $msg
);
if ($result ne 'yes') {
return undef;
}
}
# For large regions, show the pause window
$total = scalar @roomList + scalar @labelList;
if ($total > $self->worldModelObj->drawPauseNum) {
$self->showPauseWin();
}
# Delete the region
$self->worldModelObj->deleteRegions(
$self->session,
TRUE, # Update Automapper windows now
$regionObj,
);
# Make the pause window invisible
$self->hidePauseWin();
return 1;
}
sub deleteTempRegionsCallback {
# Called by $self->enableRegionsColumn
# Deletes all temporary regions
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if there are no temporary regions or if the user declines
# to continue, when prompted
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$msg, $result, $total,
@tempList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->deleteTempRegionsCallback',
@_,
);
}
# (No standard callback checks for this function)
# Get a list of temporary region objects
foreach my $regionObj ($self->worldModelObj->ivValues('regionModelHash')) {
if ($regionObj->tempRegionFlag) {
push (@tempList, $regionObj);
}
}
if (! @tempList) {
$self->showMsgDialogue(
'Delete temporary regions',
'error',
'The world model doesn\'t contain any temporary regions',
'ok',
);
return undef;
} else {
# Give the user a chance to change their minds, before emptying the region
if (@tempList == 1) {
$msg = 'There is 1 temporary region in the world model. Are you sure you want to'
. ' delete it?';
} else {
$msg = 'There are ' . scalar @tempList . ' temporary regions in the world model.'
. ' Are you sure you want to delete them all?'
}
$result = $self->showMsgDialogue(
'Delete temporary regions',
'question',
$msg,
'yes-no',
);
if ($result ne 'yes') {
return undef;
}
}
# Work out roughly how many rooms and labels will be deleted. If it's a lot, show a pause
# window
$total = 0;
foreach my $regionObj (@tempList) {
my $regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $regionObj->name);
$total += $regionmapObj->ivPairs('gridRoomHash');
$total += $regionmapObj->ivPairs('gridLabelHash');
}
if ($total > $self->worldModelObj->drawPauseNum) {
$self->showPauseWin();
}
# Delete each temporary region in turn
$self->worldModelObj->deleteTempRegions(
$self->session,
TRUE, # Update Automapper windows now
);
# Make the pause window invisible
$self->hidePauseWin();
return 1;
}
# Menu 'Rooms' column callbacks
sub resetLocatorCallback {
# Called by $self->enableRoomsColumn
# Resets the Locator task, and marks the automapper as lost
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetLocatorCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Reset the Locator task
$self->session->pseudoCmd('resetlocatortask', $self->pseudoCmdMode);
# The call to ;resetlocatortask should mark the automapper as lost - but, if it's not, do it
# from here
if ($self->mapObj->currentRoom) {
return $self->mapObj->setCurrentRoom();
}
# Display an explanatory message, if necessary
if ($self->worldModelObj->explainGetLostFlag) {
$self->session->writeText('MAP: Lost because of a Locator reset');
}
return 1;
}
sub setFacingCallback {
# Called by $self->enableRoomsColumn
# Sets the direction the character is facing
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$dictObj, $choice,
@comboList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setFacingCallback', @_);
}
# (No standard callback check)
# Import the current dictionary (for convenience)
$dictObj = $self->session->currentDict;
# The permitted facing directions are n/ne/e/se/s/sw/w/nw
foreach my $dir (qw (north northeast east southeast south southwest west northwest)) {
# Use custom primary directions in the combo, then convert the user's choice back into
# a standard primary direction
push (@comboList, $dictObj->ivShow('primaryDirHash', $dir));
}
# Prompt the user
$choice = $self->showComboDialogue(
'Set facing direction',
'Set the direction the character is facing',
\@comboList,
);
if (defined $choice) {
$self->session->mapObj->set_facingDir($choice);
}
return 1;
}
sub resetFacingCallback {
# Called by $self->enableRoomsColumn
# Resets the direction the character is facing
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetFacingCallback', @_);
}
# (No standard callback check)
# Reset the facing direction
$self->session->mapObj->set_facingDir();
# Show a confirmation
$self->showMsgDialogue(
'Reset facing direction',
'info',
'The direction your character is facing has been reset',
'ok',
);
return 1;
}
sub editLocatorRoomCallback {
# Called by $self->enableRoomsColumn
# Opens a GA::EditWin::ModelObj::Room for the Locator task's current (non-model) room
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the Locator task doesn't know the current location
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $taskObj;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->editLocatorRoomCallback',
@_,
);
}
# (No standard callback checks for this function)
# Check there's a Locator task which knows the current room
$taskObj = $self->session->locatorTask;
if (! $taskObj || ! $taskObj->roomObj) {
# Show a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'View Locator room',
'error',
'Either the Locator task isn\'t running or it doesn\'t know the current location',
'ok',
);
return undef;
} else {
# Open up an 'edit' window to edit the object
$self->createFreeWin(
'Games::Axmud::EditWin::ModelObj::Room',
$self,
$self->session,
'Edit non-model room object',
$taskObj->roomObj,
FALSE, # Not temporary
);
return 1;
}
}
sub processPathCallback {
# Called by $self->enableRoomsColumn (also called by GA::Cmd::Go->do)
# Performs the A* algorithm to find a path between the current room and the selected room,
# and then does something with it
#
# Expected arguments
# $mode - Set to one of the following:
# 'select_room' - shows the path by selecting every room along the route
# 'pref_win' - shows the path in a 'pref' window, allowing the user to store
# it as a pre-defined route (using the ';addroute' command)
# 'send_char' - sends the character to the selected room
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if no path can be
# found between the current and selected rooms
# 1 otherwise
my ($self, $mode, $check) = @_;
# Local variables
my (
$dictObj, $text, $count, $maxChars, $string, $lastExitObj, $roomListRef, $exitListRef,
$response,
@roomList, @exitList, @cmdList, @reverseCmdList, @highlightList, @modList,
);
# Check for improper arguments
if (
! defined $mode
|| ($mode ne 'select_room' && $mode ne 'pref_win' && $mode ne 'send_char')
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->processPathCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->mapObj->currentRoom
|| ! $self->selectedRoom
|| $self->mapObj->currentRoom eq $self->selectedRoom
) {
return undef;
}
# Import the current dictionary (for speed)
$dictObj = $self->session->currentDict;
# Use the universal version of the A* algorithm to find a path between the current and
# selected rooms (if they're in the same region, the call is automatically redirected to
# ->findPath)
($roomListRef, $exitListRef) = $self->worldModelObj->findUniversalPath(
$self->session,
$self->mapObj->currentRoom,
$self->selectedRoom,
$self->worldModelObj->avoidHazardsFlag,
);
if (! defined $roomListRef || ! @$roomListRef) {
# There is no path between the current and selected room. Notify the user with a popup
$self->showMsgDialogue(
'No path found',
'warning',
'There is no known path between the current room (#'
. $self->mapObj->currentRoom->number . ') and the selected room (#'
. $self->selectedRoom->number . ')',
'ok',
);
return undef;
}
# Apply post-processing to the path to remove jagged edges (if allowed)
if ($self->worldModelObj->postProcessingFlag) {
($roomListRef, $exitListRef) = $self->worldModelObj->smoothPath(
$self->session,
$roomListRef,
$exitListRef,
$self->worldModelObj->avoidHazardsFlag,
);
}
# Convert the list references returned by the called functions into lists
@roomList = @$roomListRef;
@exitList = @$exitListRef;
# Compile a list of commands to get from one end of the route to the other. If assisted
# moves are turned on, use them; otherwise, use each exit's nominal direction
# At the same time, try to compile a list of directions that lead from the end of the
# route back to the start
@cmdList = $self->worldModelObj->convertExitList($self->session, @exitList);
# Attempt to find the reverse list of directions, if possible (but only bother in
# 'select_room' mode)
if ($mode eq 'pref_win') {
@reverseCmdList = $self->worldModelObj->findPathCmds($self->session, -1, @roomList);
}
# 'select_room' - select each room in the path, in order to highlight the route (but don't
# select the current room)
# 'pref_win' - show the route/reverse route in a 'pref' window
if ($mode eq 'select_room' || $mode eq 'pref_win') {
foreach my $roomObj (@roomList) {
if ($roomObj ne $self->mapObj->currentRoom) {
push (@highlightList, $roomObj, 'room');
}
}
$self->setSelectedObj(
\@highlightList,
TRUE, # Select multiple objects, including the currently selected room
);
}
# 'pref_win' - show the route/reverse route in a 'pref' window, allowing the user to store
# it as a pre-defined route (using the ';addroute' command)
if ($mode eq 'pref_win') {
# Open up a path 'pref' window to specify task settings
$self->createFreeWin(
'Games::Axmud::PrefWin::Path',
$self,
$self->session,
# Use 'Edit path' rather than 'Path preferences'
'Edit path',
# No ->editObj
undef,
# The path itself is temporary (although can be stored as a GA::Obj::Route)
TRUE,
# Config
'room_list' => $roomListRef,
'exit_list' => $exitListRef,
'cmd_list' => \@cmdList,
'reverse_list' => \@reverseCmdList,
);
}
# 'send_char' - Select every room on the path, so that the user can see where the path is,
# before moving to the destination room (don't worry about not selecting the current room,
# as the character is about to move to a new room anyway)
if ($mode eq 'send_char') {
foreach my $roomObj (@roomList) {
push (@highlightList, $roomObj, 'room');
}
$self->setSelectedObj(
\@highlightList,
TRUE, # Select multiple objects, including the currently selected room
);
# Offer the user to opportunity to change their mind. Only display one 'dialogue'
# window; if the user clicks the 'yes' button, go ahead and move
if ($self->mode eq 'wait') {
$response = $self->showMsgDialogue(
'Move to room',
'question',
'The automapper is in \'wait\' mode. Do you really want to move to the'
. ' double-clicked room?',
'yes-no',
);
if ($response ne 'yes') {
# Don't move anywhere
return 1;
}
} elsif ($self->session->locatorTask->moveList) {
$response = $self->showMsgDialogue(
'Move to room',
'question',
'The Locator task is expecting more room statements; the room displayed'
. ' as the automapper\'s current room probably isn\'t the correct one.'
. ' Do you really want to move to the double-clicked room?',
'yes-no',
);
if ($response ne 'yes') {
# Don't move anywhere
return 1;
}
} elsif (
$self->worldModelObj->pathFindStepLimit
&& $self->worldModelObj->pathFindStepLimit < scalar @cmdList
) {
$response = $self->showMsgDialogue(
'Move to room',
'warning',
'The path contains a large number of steps (' . scalar @cmdList . '). Do you'
. ' really want to move to the double-clicked room?',
'yes-no',
);
if ($response ne 'yes') {
# Don't move anywhere
return 1;
}
}
# By making a single call to GA::Session->worldCmd, using a command string like
# 'north;east;north', we avoid the need to redraw the ghost room dozens of hundreds of
# times (a slow process)
# Abbreviate any primary/secondary directions, if possible
foreach my $cmd (@cmdList) {
my $abbrevDir = $dictObj->abbrevDir($cmd);
# (For secondary directions like 'in' with no abbreviation, ->abbrevDir returns
# 'undef', in which case we should use the original $cmd)
if (defined $abbrevDir) {
push (@modList, $abbrevDir);
} else {
push (@modList, $cmd);
}
}
# Take the route
$self->session->worldCmd(join($axmud::CLIENT->cmdSep, @modList));
} else {
# Unrecognised mode
return undef;
}
return 1;
}
sub adjacentModeCallback {
# Called by $self->enableRoomsColumn (only)
# Opens a dialogue window to set values of GA::Obj::WorldModel->adjacentMode and
# ->adjacentCount
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, or if the user declines to set valid values
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($mode, $count);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->adjacentModeCallback', @_);
}
# (No standard callback check)
($mode, $count) = $self->promptAdjacentMode();
if (defined $mode) {
if ($mode eq 'near') {
if (! $axmud::CLIENT->intCheck($count, 0)) {
$self->showMsgDialogue(
'Adjacent regions regions mode',
'error',
'The number must be a positive integer (or zero)',
'ok',
);
return undef;
} else {
$self->worldModelObj->set_adjacentMode($mode, $count);
}
} else {
$self->worldModelObj->set_adjacentMode($mode);
}
}
return 1;
}
sub moveSelectedRoomsCallback {
# Called by $self->enableEditColumn
# Prompts the user to select the direction in which to move the selected rooms (and any
# selected labels, if there is at least one selected room)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user
# declines to specify a valid distance and direction or if the move operation fails
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$dictObj, $distance, $choice, $standardDir,
@shortList, @longList, @dirList, @customList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->moveSelectedRoomsLabelsCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Must reset free click mode, so 'move rooms' and 'move rooms to click' can't be combined
# accidentally
$self->reset_freeClickMode();
# Import the current dictionary
$dictObj = $self->session->currentDict;
# 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(
north northeast east southeast south southwest west northwest up down
northnortheast eastnortheast eastsoutheast southsoutheast
southsouthwest westsouthwest westnorthwest northnorthwest
);
if ($self->worldModelObj->showAllPrimaryFlag) {
@dirList = @longList;
} else {
@dirList = @shortList;
}
# Get a list of (custom) primary directions, in the standard order
foreach my $key (@dirList) {
push (@customList, $dictObj->ivShow('primaryDirHash', $key));
}
# Prompt the user for a distance and a direction
($distance, $choice) = $self->showEntryComboDialogue(
'Move selected rooms',
'Enter a distance (in gridblocks)',
'Select the direction of movement',
\@customList,
);
# If the 'cancel' button was clicked, $distance will be 'undef'. The user might also have
# entered the distance 0. In either case, we don't move anything
if (! $distance) {
# Operation cancelled
return undef;
} else {
# Check that the distance is a positive integer
if (! $axmud::CLIENT->intCheck($distance, 1)) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The distance must be a positive integer',
'ok',
);
return undef;
}
# $dir is a custom primary direction; convert it into the standard primary direction
$standardDir = $dictObj->ivShow('combRevDirHash', $choice);
# Move the selected room(s)
return $self->moveRoomsInDir($distance, $standardDir);
}
}
sub transferSelectedRoomsCallback {
# Called by $self->enableEditColumn and ->enableRoomsPopupMenu
# Transfers the selected rooms (and any selected labels, if there is at least one selected
# room) to the same location in a specified region
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $regionName - The name of the region into which the rooms/labels should be
# transferred. All selected rooms/labels must be in the same region,
# and that region must not be the same as $regionName. If 'undef', the
# user is prompted to select a region
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the move
# operation fails
# 1 otherwise
my ($self, $regionName, $check) = @_;
# Local variables
my @comboList;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->transferSelectedRoomsCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Make sure any free click mode operations, like connecting exits or moving rooms, are
# cancelled
$self->reset_freeClickMode();
# Prompt the user to select a region, if no region was specified by the calling function
if (! defined $regionName) {
# Get a sorted list of region names
@comboList = sort {lc($a) cmp lc($b)} ($self->worldModelObj->ivKeys('regionmapHash'));
# Prompt the user for a region name
$regionName = $self->showComboDialogue(
'Select region',
'Select the destination region',
\@comboList,
);
if (! defined $regionName) {
return undef;
}
}
# Move the selected rooms/labels
return $self->transferRoomsToRegion($regionName);
}
sub compareRoomCallback {
# Called by $self->->enableRoomsPopupMenu
# Compares the selected room with rooms in the region or the whole world model, and selects
# any matching rooms
#
# Expected arguments
# $wholeFlag - FALSE to compare rooms in the same region, TRUE to compare rooms in the
# whole world model
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the move
# operation fails
# 1 otherwise
my ($self, $wholeFlag, $check) = @_;
# Local variables
my (
$wmObj, $selectObj, $regionmapObj, $string,
@roomList, @matchList, @selectList,
);
# Check for improper arguments
if (! defined $wholeFlag || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->compareRoomCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedRoom) {
return undef;
}
# Import the world model object and the selected room (for speed)
$wmObj = $self->worldModelObj;
$selectObj = $self->selectedRoom;
# Get a list of rooms which should be compared with the selected room
if (! $wholeFlag) {
$regionmapObj = $self->findRegionmap($self->selectedRoom->parent);
foreach my $roomNum ($regionmapObj->ivValues('gridRoomHash')) {
push (@roomList, $wmObj->ivShow('modelHash', $roomNum));
}
} else {
push (@roomList, $wmObj->ivValues('roomModelHash'));
}
# Compare rooms in each region, one by one
foreach my $thisObj (@roomList) {
my $result;
if ($thisObj ne $selectObj) {
($result) = $wmObj->compareRooms($self->session, $selectObj, $thisObj);
if ($result) {
push (@matchList, $thisObj);
push (@selectList, $thisObj, 'room');
}
}
}
if (! @matchList) {
# Show a confirmation
return $self->showMsgDialogue(
'Compare room',
'error',
'No matching rooms found',
'ok',
);
} else {
# Unselect the currently-selected room...
$self->setSelectedObj();
# ...so we can select all matching rooms. The TRUE argument means to select multiple
# objects
$self->setSelectedObj(\@selectList, TRUE);
if ((scalar @matchList) == 1) {
$string = '1 room';
} else {
$string = (scalar @matchList) . ' rooms';
}
# Show a confirmation
return $self->showMsgDialogue(
'Compare room',
'info',
'Found ' . $string . ' matching room #' . $selectObj->number,
'ok',
);
}
}
sub executeScriptsCallback {
# Called by $self->enableRoomsPopupMenu
# Executes Axbasic scripts for the current room, as if the character had just arrived
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->executeScriptsCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->mapObj->currentRoom) {
return undef;
}
# If there are no Axbasic scripts for the current room, display a warning
if (! $self->mapObj->currentRoom->arriveScriptList) {
return $self->showMsgDialogue(
'Run ' . $axmud::BASIC_NAME . ' scripts',
'warning',
'The current room has not been assigned any ' . $axmud::BASIC_NAME . ' scripts',
'ok',
);
}
# Otherwise, execute the scripts
foreach my $scriptName ($self->mapObj->currentRoom->arriveScriptList) {
$self->session->pseudoCmd('runscript ' . $scriptName);
}
return 1;
}
sub addFirstRoomCallback {
# Called by $self->enableRoomsColumn. Also called by Axbasic ADDFIRSTROOM function
# For an empty region, draws a room in the centre of the grid and marks it as the current
# room
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the Locator task
# isn't running or if it is still expecting room statements or if the new room can't
# be created
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($xPosBlocks, $yPosBlocks, $zPosBlocks, $newRoomObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addFirstRoomCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || $self->currentRegionmap->gridRoomHash) {
return undef;
}
# If the Locator's ->moveList isn't empty, we won't be able to switch to 'update' mode.
# Therefore refuse to add the first room if the list isn't empty (or if the Locator task
# isn't running at all)
if (! $self->session->locatorTask) {
$self->showMsgDialogue(
'Add first room',
'error',
'Can\'t add a room at the centre of the map - the Locator task is not running',
'ok',
);
return undef;
} elsif ($self->session->locatorTask->moveList) {
$self->showMsgDialogue(
'Add first room',
'error',
'Can\'t add a room at the centre of the map - the Locator task is not ready',
'ok',
);
return undef;
}
# Find the coordinates of the middle of the grid
($xPosBlocks, $yPosBlocks, $zPosBlocks) = $self->currentRegionmap->getGridCentre();
# Check the location to make sure there's not already a room there
if ($self->currentRegionmap->fetchRoom($xPosBlocks, $yPosBlocks, $zPosBlocks)) {
$self->showMsgDialogue(
'Add first room',
'error',
'Can\'t add a room at the centre of the map - the position is already occupied',
'ok',
);
return undef;
}
# Free click mode must be reset (nothing special happens when the user clicks on the map)
$self->reset_freeClickMode();
# Create a new room object, with this region as its parent, and update the map
if ($self->session->locatorTask && $self->session->locatorTask->roomObj) {
# Set the Automapper window's mode to 'update', make the new room the current location
# and copy properties from the Locator task's current room (where allowed)
$newRoomObj = $self->mapObj->createNewRoom(
$self->currentRegionmap,
$xPosBlocks,
$yPosBlocks,
$zPosBlocks,
'update',
TRUE,
TRUE,
);
} else {
# Locator task doesn't know the current location, so don't make the new room the
# current room, and don't change the mode
$newRoomObj = $self->mapObj->createNewRoom(
$self->currentRegionmap,
$xPosBlocks,
$yPosBlocks,
$zPosBlocks,
);
}
if (! $newRoomObj) {
# Could not create the new room (an error message has already been displayed)
return undef;
} else {
# Also update the Locator with the new current room (if there is one)
$self->mapObj->updateLocator();
return 1;
}
}
sub addRoomAtBlockCallback {
# Called by $self->enableRoomsColumn. Also called by the Axbasic ADDROOM function
# Prompts the user to supply a gridblock (via a 'dialogue' window) and creates a room at
# that location. When called by Axbasic, uses the supplied gridblock
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $xPosBlocks, $yPosBlocks, $zPosBlocks
# - The coordinates on the gridblock at which to draw the room
#
# Return values
# 'undef' on improper arguments,if the standard callback check fails, if the user cancels
# the 'dialogue' window or if the new room can't be created
# 1 otherwise
my ($self, $xPosBlocks, $yPosBlocks, $zPosBlocks, $check) = @_;
# Local variables
my $roomObj;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addRoomAtBlockCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Prompt the user for a gridblock, if one was not specified
if (! defined $xPosBlocks || ! defined $yPosBlocks || ! defined $zPosBlocks) {
($xPosBlocks, $yPosBlocks, $zPosBlocks) = $self->promptGridBlock();
if (! defined $xPosBlocks ) {
# User clicked the 'cancel' button
return undef;
}
}
# Check that the specified gridblock actually exists
if (
! $self->currentRegionmap->checkGridBlock(
$xPosBlocks,
$yPosBlocks,
$zPosBlocks,
)
) {
$self->showMsgDialogue(
'Add room',
'error',
'The gridblock x=' . $xPosBlocks . ', y=' . $yPosBlocks . ', z=' . $zPosBlocks
. ' is invalid',
'ok',
);
return undef;
}
# Check that the gridblock isn't occupied
if ($self->currentRegionmap->fetchRoom($xPosBlocks, $yPosBlocks, $zPosBlocks)) {
$self->showMsgDialogue(
'Add room',
'error',
'The gridblock x=' . $xPosBlocks . ', y=' . $yPosBlocks . ', z=' . $zPosBlocks
. ' is already occupied',
'ok',
);
return undef;
}
# Free click mode must be reset (nothing special happens when the user clicks on the map)
$self->reset_freeClickMode();
# Create a new room object, with this region as its parent and update the map
$roomObj = $self->mapObj->createNewRoom(
$self->currentRegionmap,
$xPosBlocks,
$yPosBlocks,
$zPosBlocks,
);
if (! $roomObj) {
# Could not create the new room (an error message has already been displayed)
return undef;
} else {
# To make it easier to see where the new room was drawn, make it the selected room, and
# centre the map on the room
$self->setSelectedObj(
[$roomObj, 'room'],
FALSE, # Select this object; unselect all other objects
);
$self->centreMapOverRoom($roomObj);
return 1;
}
}
sub addExitCallback {
# Called by $self->enableRoomsColumn
# Adds a new exit, prompting the user for its properties
#
# Expected arguments
# $hiddenFlag - If set to TRUE, a hidden exit should be created (otherwise set to FALSE)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user clicks
# 'cancel' on the 'dialogue' window or if the exit can't be added
# 1 otherwise
my ($self, $hiddenFlag, $check) = @_;
# Local variables
my (
$title, $dir, $mapDir, $assistedProf, $assistedMove, $result, $exitObj, $redrawFlag,
$roomObj,
);
# Check for improper arguments
if (! defined $hiddenFlag || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedRoom) {
return undef;
}
# Prompt the user for properties of the new exit
if ($hiddenFlag) {
$title = 'Add hidden exit';
} else {
$title = 'Add exit';
}
($dir, $mapDir, $assistedProf, $assistedMove) = $self->promptNewExit(
$self->selectedRoom,
$title,
);
if (! defined $dir) {
return undef;
}
# Add the exit
$exitObj = $self->worldModelObj->addExit(
$self->session,
FALSE, # Don't redraw the map yet...
$self->selectedRoom,
$dir,
$mapDir,
);
if (! $exitObj) {
return undef;
}
# Add an entry to the exit's assisted moves hash, if one was specified by the user
if ($assistedProf && $assistedMove) {
$self->worldModelObj->setAssistedMove($exitObj, $assistedProf, $assistedMove);
}
# Mark it as a hidden exit, if necessary
if ($hiddenFlag) {
$self->worldModelObj->setHiddenExit(
FALSE, # Don't redraw the map yet...
$exitObj,
TRUE, # Exit is now hidden
);
}
# Now, we need to check if the room has any more unallocated exits. If they've temporarily
# been assigned the map direction 'undef', we must reallocate them
OUTER: foreach my $number ($self->selectedRoom->ivValues('exitNumHash')) {
my $thisExitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if (! defined $thisExitObj->mapDir && $thisExitObj->drawMode eq 'primary') {
# Assign the exit object a new map direction (using one of the sixteen cardinal
# directions, but not 'up' and 'down'), if any are available
$self->worldModelObj->allocateCardinalDir(
$self->session,
$self->selectedRoom,
$thisExitObj,
);
}
}
# Now, if there are any incoming 1-way exits whose ->mapDir is the opposite of the exit
# we've just added, the incoming exit should be marked as an uncertain exit
$self->worldModelObj->modifyIncomingExits(
$self->session,
TRUE, # Redraw any modified incoming exit
$self->selectedRoom,
$exitObj,
);
# Remember the (currently selected) room object that must be redrawn in every window
$roomObj = $self->selectedRoom;
# Make this exit the selected exit (which redraws it in this window)
$self->setSelectedObj(
[$exitObj, 'exit'],
FALSE, # Select this object; unselect all other objects
);
# Redraw the selected room in every window
$self->worldModelObj->updateMaps('room', $roomObj);
return 1;
}
sub addMultipleExitsCallback {
# Called by $self->enableRoomsColumn
# Prompts the user to select one or more map directions to add to the selected room(s), and
# then adds them
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user doesn't
# select any directions or if an attempt to create an exit fails
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$hiddenFlag,
@dirList, @drawList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addMultipleExitsCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (! $self->selectedRoom && ! $self->selectedRoomHash)
) {
return undef;
}
# Prompt the user to select some of the selected room's available primary directions
($hiddenFlag, @dirList) = $self->promptMultipleExits($self->selectedRoom);
if (defined $hiddenFlag && @dirList) {
OUTER: foreach my $roomObj ($self->compileSelectedRooms) {
INNER: foreach my $customDir (@dirList) {
my ($mapDir, $exitObj);
# $customDir is a custom primary direction. Get the equivalent standard
# direction
$mapDir = $self->session->currentDict->ivShow('combRevDirHash', $customDir);
# If the exit doesn't already exist, add it
if (! $roomObj->ivExists('exitNumHash', $customDir)) {
# Add the normal exit
$exitObj = $self->worldModelObj->addExit(
$self->session,
FALSE, # Don't redraw the map yet...
$roomObj,
$customDir,
$mapDir,
);
if (! $exitObj) {
$self->showMsgDialogue(
'Add multiple exits',
'error',
'Failed to add one or more exits (internal error)',
'ok',
);
return undef;
}
# Mark it as a hidden exit, if necessary
if ($hiddenFlag) {
$self->worldModelObj->setHiddenExit(
FALSE, # Don't redraw the map yet...
$exitObj,
TRUE, # Exit is now hidden
);
}
# Mark the room to be redrawn
push (@drawList, 'room', $roomObj);
# Now, if there are any incoming 1-way exits whose ->mapDir is the opposite
# of the exit we've just added, the incoming exit should be marked as an
# uncertain exit
$self->worldModelObj->modifyIncomingExits(
$self->session,
TRUE, # Redraw any modified incoming exit
$roomObj,
$exitObj,
);
}
}
}
# Redraw the selected room(s) in every window
$self->worldModelObj->updateMaps(@drawList);
return 1;
} else {
# No exits were selected
return undef;
}
}
sub addFailedExitCallback {
# Called by $self->enableRoomsColumn
# When the character fails to move, and it's not a recognised failed exit pattern, the map
# gets messed up
# This is a convenient way to deal with it. Adds a new failed exit string to the current
# world profile or to the specified room, and empties the Locator's move list
#
# Expected arguments
# $worldFlag - If set to TRUE, a failed exit pattern is added to the world profile. If
# set to FALSE, the pattern is added to the room
#
# Optional arguments
# $roomObj - If $worldFlag is FALSE, the room to which the pattern should be added.
# When called by $self->enableRoomsColumn, it will be the current room;
# when called by ->enableRoomsPopupMenu, it will be the selected room
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# doesn't supply a pattern
# 1 otherwise
my ($self, $worldFlag, $roomObj, $check) = @_;
# Local variables
my (
$pattern, $type, $worldObj, $iv, $descrip, $taskObj,
@comboList,
);
# Check for improper arguments
if (! defined $worldFlag || (! $worldFlag && ! defined $roomObj) || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addFailedExitCallback', @_);
}
# Standard callback check
if (
$roomObj
&& (
! $self->currentRegionmap
|| (! $self->mapObj->currentRoom && ! $self->selectedRoom)
)
) {
return undef;
}
if (! $worldFlag) {
# Prompt the user for a new failed exit pattern to add to the room
$pattern = $self->showEntryDialogue(
'Add failed exit to room',
'Enter a pattern to match the failed exit',
);
if (! $pattern) {
return undef;
} else {
$self->worldModelObj->addExitPattern($roomObj, 'fail', $pattern);
}
} else {
# Import the current world profile
$worldObj = $self->session->currentWorld;
# Prompt the user for a new failed exit pattern to add to the world profile
@comboList = ('Closed door', 'Locked door', 'Other failed exit');
($pattern, $type) = $self->showEntryComboDialogue(
'Add failed exit to world',
'Enter a pattern to match the failed exit',
'Which kind of failed exit was it?',
\@comboList,
);
if (! ($pattern && $type)) {
return undef;
} else {
# Check that the pattern isn't already in the list
if ($type eq 'Closed door') {
$iv = 'doorPatternList';
$descrip = 'a closed door pattern';
} elsif ($type eq 'Locked door') {
$iv = 'lockedPatternList';
$descrip = 'a locked door pattern';
} else {
$iv = 'failExitPatternList';
$descrip = 'a failed exit pattern';
}
if ($worldObj->ivMatch($iv, $pattern)) {
$self->showMsgDialogue(
'Add failed exit to world',
'error',
'The current world profile already has ' . $descrip . ' pattern matching \''
. $pattern . '\'',
'ok',
);
return undef;
} else {
# Add the pattern
$worldObj->ivPush($iv, $pattern);
}
}
}
# Import the Locator task
$taskObj = $self->session->locatorTask;
if ($taskObj) {
# Empty the Locator's move list IVs and update its task window
$taskObj->resetMoveList();
}
return 1;
}
sub addInvoluntaryExitCallback {
# Called by $self->enableRoomsColumn
# This callback adds an involuntary exit pattern to the specified room and empties the
# Locator task's move list
#
# Expected arguments
# $roomObj - The room to which the pattern should be added. When called by
# $self->enableRoomsColumn, it will be the current room; when called by
# ->enableRoomsPopupMenu, it will be the selected room
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# doesn't supply a pattern
# 1 otherwise
my ($self, $roomObj, $check) = @_;
# Local variables
my ($pattern, $otherVal, $taskObj);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addInvoluntaryExitCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (! $self->mapObj->currentRoom && ! $self->selectedRoom)
) {
return undef;
}
# Prompt the user for a new involuntary exit pattern to add to the room
($pattern, $otherVal) = $self->showDoubleEntryDialogue(
'Add involuntary exit to room',
'Enter a pattern to match the involuntary exit',
'(Optional) add a direction or a destination room',
);
if (! defined $pattern || $pattern eq '') {
return undef;
} else {
# Use 'undef' rather than an empty string
if ($otherVal eq '') {
$otherVal = undef;
}
$self->worldModelObj->addInvoluntaryExit($roomObj, $pattern, $otherVal);
# Import the Locator task
$taskObj = $self->session->locatorTask;
if ($taskObj) {
# Empty the Locator's move list IVs and update its task window
$taskObj->resetMoveList();
}
}
return 1;
}
sub addRepulseExitCallback {
# Called by $self->enableRoomsColumn
# This callback adds a repulse exit pattern to the specified room and empties the Locator
# task's move list
#
# Expected arguments
# $roomObj - The room to which the pattern should be added. When called by
# $self->enableRoomsColumn, it will be the current room; when called by
# ->enableRoomsPopupMenu, it will be the selected room
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# doesn't supply a pattern
# 1 otherwise
my ($self, $roomObj, $check) = @_;
# Local variables
my ($pattern, $otherVal, $taskObj);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addRepulseExitCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (! $self->mapObj->currentRoom && ! $self->selectedRoom)
) {
return undef;
}
# Prompt the user for a new repulse exit pattern to add to the room
($pattern, $otherVal) = $self->showDoubleEntryDialogue(
'Add repulse exit to room',
'Enter a pattern to match the repulse exit',
'(Optional) add a direction or a destination room',
);
if (! defined $pattern || $pattern eq '') {
return undef;
} else {
# Use 'undef' rather than an empty string
if ($otherVal eq '') {
$otherVal = undef;
}
$self->worldModelObj->addRepulseExit($roomObj, $pattern, $otherVal);
# Import the Locator task
$taskObj = $self->session->locatorTask;
if ($taskObj) {
# Empty the Locator's move list IVs and update its task window
$taskObj->resetMoveList();
}
}
return 1;
}
sub addSpecialDepartureCallback {
# Called by $self->enableRoomsColumn
# When the character moves using an exit which doesn't send a room statement upon arrival
# in the new room - usually after some kind of faller - the pattern sent by the world to
# confirm arrival (such as 'You land in a big heap!') should be interpreted by the
# Locator task as a special kind of room statement
# This callback adds a special departure pattern to the specified room and empties the
# Locator task's move list
#
# Expected arguments
# $roomObj - The room to which the pattern should be added. When called by
# $self->enableRoomsColumn, it will be the current room; when called by
# ->enableRoomsPopupMenu, it will be the selected room
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# doesn't supply a pattern
# 1 otherwise
my ($self, $roomObj, $check) = @_;
# Local variables
my ($pattern, $taskObj);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addSpecialDepartureCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (! $self->mapObj->currentRoom && ! $self->selectedRoom)
) {
return undef;
}
# Prompt the user for a new special departure pattern to add to the room
$pattern = $self->showEntryDialogue(
'Add special departure to room',
'Enter a pattern to match the special departure',
);
if (! $pattern) {
return undef;
} else {
$self->worldModelObj->addExitPattern($roomObj, 'special', $pattern);
# Import the Locator task
$taskObj = $self->session->locatorTask;
if ($taskObj) {
# Empty the Locator's move list IVs and update its task window
$taskObj->resetMoveList();
}
}
return 1;
}
sub addUnspecifiedPatternCallback {
# Called by $self->enableRoomsColumn
# GA::Profile::World->unspecifiedRoomPatternList provides a list of patterns that match
# a line in 'unspecified' rooms (those that don't use a recognisable room statement;
# typically a room whose exit list is completely obscured)
# Each room has its own list of patterns that match a line in 'unspecified' rooms; this
# callback adds a pattern to that list
#
# Expected arguments
# $roomObj - The room to which the pattern should be added. When called by
# $self->enableRoomsColumn, it will be the current room; when called by
# ->enableRoomsPopupMenu, it will be the selected room
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# doesn't supply a pattern
# 1 otherwise
my ($self, $roomObj, $check) = @_;
# Local variables
my ($pattern, $taskObj);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addUnspecifiedPatternCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (! $self->mapObj->currentRoom && ! $self->selectedRoom)
) {
return undef;
}
# Prompt the user for a new unspecified room pattern to add to the room
$pattern = $self->showEntryDialogue(
'Add unspecified room pattern',
'Enter a pattern to match an unspecified room',
);
if (! $pattern) {
return undef;
} else {
$self->worldModelObj->addExitPattern($roomObj, 'unspecified', $pattern);
# Import the Locator task
$taskObj = $self->session->locatorTask;
if ($taskObj) {
# Empty the Locator's move list IVs and update its task window
$taskObj->resetMoveList();
}
}
return 1;
}
sub removeCheckedDirCallback {
# Called by $self->enableRoomsColumn and ->enableRoomsPopupMenu
# Removes one or all checked directions from the selected room
#
# Expected arguments
# $allFlag - If set to TRUE, all checked directions are removed. If set to FALSE, the
# user is prompted to choose an exit
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# clicks 'cancel' on the 'dialogue' window
# 1 otherwise
my ($self, $allFlag, $check) = @_;
# Local variables
my (
$choice,
@comboList, @sortedList,
);
# Check for improper arguments
if (! defined $allFlag || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->removeCheckedDirCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedRoom
|| ! $self->selectedRoom->checkedDirHash
) {
return undef;
}
if ($allFlag) {
# Delete all checked directions
$self->selectedRoom->ivEmpty('checkedDirHash');
} else {
@comboList = sort {lc($a) cmp lc($b)} ($self->selectedRoom->ivKeys('checkedDirHash'));
@sortedList = $self->session->currentDict->sortExits(@comboList);
# Prompt the user for a checked direction to remove (even if there's only one)
$choice = $self->showComboDialogue(
'Remove checked direction',
'Select the checked direction to remove',
\@comboList,
);
if (! defined $choice) {
return undef;
} else {
$self->selectedRoom->ivDelete('checkedDirHash', $choice);
}
}
# Redraw the selected room in every window
$self->worldModelObj->updateMaps('room', $self->selectedRoom);
return 1;
}
sub setWildCallback {
# Called by $self->enableRoomsColumn and ->enableRoomsPopupMenu
# Sets the selected room(s)' wilderness mode
#
# Expected arguments
# $mode - One of the values for GA::ModelObj::Room->wildMode - 'normal', 'border' or
# 'wild'
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $mode, $check) = @_;
# Local variables
my @drawList;
# Check for improper arguments
if (
! defined $mode
|| ($mode ne 'normal' && $mode ne 'border' && $mode ne 'wild')
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setWildCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap && (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# For each selected room, convert their wilderness mode. The called function handles
# redrawing
$self->worldModelObj->setWildernessRoom(
$self->session,
TRUE, # Update automapper windows
$mode,
$self->compileSelectedRooms(),
);
return 1;
}
sub selectExitCallback {
# Called by $self->enableRoomsColumn
# Prompts the user to select an exit manually
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if there are no
# exits to select, or if the user clicks 'cancel' in the 'dialogue' window
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$choice, $selectExitObj,
@exitList, @comboList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedRoom) {
return undef;
}
# Get a list of the select room's exits, in the standard order
@exitList = $self->selectedRoom->sortedExitList;
# Compile a hash in the form
# $hash{'informative_string'} = blessed_reference_to_exit_object
foreach my $dir (@exitList) {
my ($exitNum, $exitObj, $string, $customDir);
# Prepare a string which shows:
# The exit's nominal direction and its exit model number
# Its temporarily allocated map direction in [square brackets]
# Its permanently allocated map direction in <diamond brackets>
# An unallocatable exit in {curly brackets}
$exitNum = $self->selectedRoom->ivShow('exitNumHash', $dir);
$exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
$string = $exitObj->dir . ' #' . $exitObj->number;
if ($exitObj->mapDir) {
# Get the equivalent custom direction, so that we can compare it to $dir
$customDir = $self->session->currentDict->ivShow(
'primaryDirHash',
$exitObj->mapDir,
);
if ($customDir ne $exitObj->dir) {
if ($exitObj->drawMode eq 'temp_alloc') {
$string .= ' [' . $exitObj->mapDir . ']';
} else {
$string .= ' <' . $exitObj->mapDir . '>';
}
}
} elsif ($exitObj->drawMode eq 'temp_unalloc') {
$string .= ' {unallocatable}';
}
# Add an entry to the hash...
$exitHash{$string} = $exitObj;
# ...and another in the combo list
push (@comboList, $string);
}
# Don't prompt for an object, if there are none available
if (! @comboList) {
return $self->showMsgDialogue(
'Select exit',
'error',
'Can\'t select an exit - this room has no exits',
'ok',
);
}
# Prompt the user to choose which exit to select
$choice = $self->showComboDialogue(
'Select exit',
'Choose which exit to select',
\@comboList,
);
if (! $choice) {
return undef;
} else {
# Get the corresponding ExitObj
$selectExitObj = $exitHash{$choice};
# Select this exit
$self->setSelectedObj(
[$selectExitObj, 'exit'],
FALSE, # Select this object; unselect all other objects
);
return 1;
}
}
sub identifyRoomsCallback {
# Called by $self->enableRoomsColumn
# Lists the current room and all the selected rooms in a 'dialogue' window (if more than 10
# are selected, we only list the first 10)
#
# 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 (
$limit, $msg, $roomName,
@roomList, @sortedList, @reducedList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->identifyRoomsCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
&& (! $self->selectedRoom && ! $self->selectedRoomHash && ! $self->mapObj->currentRoom)
) {
return undef;
}
# Compile a list of selected rooms, sorted by world model number
@roomList = $self->compileSelectedRooms();
@sortedList = sort {$a->number <=> $b->number} (@roomList);
# Reduce the size of the list to a maximum of 10
$limit = 10;
if (@sortedList > $limit) {
@reducedList = @sortedList[0..($limit - 1)];
} else {
@reducedList = @sortedList;
}
# Prepare the message to show in the window
if ($self->mapObj->currentRoom) {
$msg = "Current room:\n";
$msg .= " #" . $self->mapObj->currentRoom->number . " '";
# '<unnamed room>' will cause a Pango error, so replace that string
# GA::ModelObj::Room->name has already been cut down to a maximum of 32 characters. By
# checking for a length longer than 31, we can be certain we're not adding an ellipsis
# to a room title that was exactly 32 characters long
$roomName = $self->mapObj->currentRoom->name;
if ($roomName eq '<unnamed room>') {
$roomName = '(unnamed room)';
} elsif (length($roomName) > 31) {
$roomName = substr($roomName, 0, 29) . '...';
}
$msg .= $roomName . "'\n\n";
} else {
$msg = '';
}
if (@reducedList) {
if (scalar @sortedList != scalar @reducedList) {
$msg .= "Selected rooms (first " . $limit . " rooms of " . scalar @sortedList
. ")";
} elsif (scalar @sortedList == 1) {
$msg .= "Selected rooms (1 room)";
} else {
$msg .= "Selected rooms (" . scalar @sortedList . " rooms)";
}
foreach my $obj (@reducedList) {
my $roomName;
$msg .= "\n #" . $obj->number . " '";
$roomName = $obj->name;
if ($roomName eq '<unnamed room>') {
$roomName = '(unnamed room)';
} elsif (length($roomName) > 31) {
$roomName = substr($roomName, 0, 29) . '...';
}
$msg .= $roomName . "'";
}
}
# Display a popup to show the results
$self->showMsgDialogue(
'Identify rooms',
'info',
$msg,
'ok',
undef,
TRUE, # Preserve newline characters in $msg
);
return 1;
}
sub updateVisitsCallback {
# Called by $self->enableRoomsColumn, ->enableRoomsPopupMenu and ->drawMiscButtonSet
# Adjusts the number of character visits shown in the selected room(s)
# Normally, the current character's visits are changed. However, if $self->showChar is set,
# that character's visits are changed
#
# Expected arguments
# $mode - 'increase' to increase the number of visits by one, 'decrease' to decrease the
# visits by one, 'manual' to let the user enter a value manually, 'reset' to
# reset the number to zero
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user clicks
# the 'cancel' button on a 'dialogue' window or for any other error
# 1 otherwise
my ($self, $mode, $check) = @_;
# Local variables
my (
$char, $current, $result, $matchFlag,
@roomList, @drawList,
);
# Check for improper arguments
if (
! defined $mode
|| ($mode ne 'increase' && $mode ne 'decrease' && $mode ne 'manual' && $mode ne 'reset')
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->updateVisitsCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Get a list of selected room(s)
@roomList = $self->compileSelectedRooms();
# Decide which character to use
if ($self->showChar) {
$char = $self->showChar;
} elsif ($self->session->currentChar) {
$char = $self->session->currentChar->name;
} else {
$self->showMsgDialogue(
'Update character visits',
'error',
'Can\'t update the number of visits - there is no current character set',
'ok',
);
return undef;
}
# Update room visits
if ($mode eq 'increase') {
# Increase by one
foreach my $roomObj (@roomList) {
if ($roomObj->ivExists('visitHash', $char)) {
$roomObj->ivIncHash('visitHash', $char);
} else {
$roomObj->ivAdd('visitHash', $char, 1);
}
}
} elsif ($mode eq 'decrease') {
# Decrease by one
foreach my $roomObj (@roomList) {
if ($roomObj->ivExists('visitHash', $char)) {
$roomObj->ivDecHash('visitHash', $char);
# If the number of visits is down to 0, remove the entry from the hash (so that
# we don't get -1 visits the next time)
if (! $roomObj->ivShow('visitHash', $char)) {
$roomObj->ivDelete('visitHash', $char);
}
}
}
} elsif ($mode eq 'manual') {
if ($self->selectedRoom) {
# Set manually (one room only)
$current = $self->selectedRoom->ivShow('visitHash', $char);
if (! $current) {
# If there's no entry for this character in the room's ->visitHash, make sure
# the 'dialogue' window displays a value of 0
$current = 0;
}
$result = $self->showEntryDialogue(
'Update character visits',
'Enter the number of visits to this room #' . $self->selectedRoom->number
. ' by \'' . $char . '\'',
undef, # No max number of characters
$current,
);
} else {
# Set manually (multiple rooms)
$result = $self->showEntryDialogue(
'Update character visits',
'Enter the number of visits for each of these ' . (scalar @roomList) . ' rooms'
. ' by \'' . $char . '\'',
undef, # No max number of characters
);
}
if (! defined $result) {
# User clicked 'cancel' button in the 'dialogue' window
return undef;
} elsif (($result =~ /\D/) || $result < 0) {
$self->showMsgDialogue(
'Update character visits',
'error',
'Invalid value (' . $result . ') - must be an integer, 0 or above',
'ok',
);
return undef;
} else {
foreach my $roomObj (@roomList) {
if ($result) {
$roomObj->ivAdd('visitHash', $char, $result);
} else {
$roomObj->ivDelete('visitHash', $char);
}
}
}
} else {
# Reset to zero
# Before resetting counts in multiple rooms, get a confirmation
if ($self->selectedRoomHash) {
$result = $self->showMsgDialogue(
'Reset character visits',
'question',
'Are you sure you want to reset character visits in all ' . (scalar @roomList)
. ' rooms?',
'yes-no',
);
if (! $result || $result eq 'no') {
# Don't reset anything
return undef;
}
}
# Reset the counts
foreach my $roomObj (@roomList) {
if ($self->selectedRoom->ivExists('visitHash', $char)) {
$self->selectedRoom->ivDelete('visitHash', $char);
}
}
}
# Mark the selected room(s) to be re-drawn, in case the room and its character visits are
# currently visible
foreach my $roomObj (@roomList) {
push (@drawList, 'room', $roomObj);
}
$self->worldModelObj->updateMaps(@drawList);
# Show a confirmation, but only if the selected room(s) are on a different level or in a
# different region altogether
if ($self->selectedRoom) {
# Get the new number of visits for the single selected room...
$current = $self->selectedRoom->ivShow('visitHash', $char);
if (! $current) {
$current = 0;
}
# ...and then show a confirmation (but only if the selected room is on a different
# level, or in a different region altogether)
if (
$self->selectedRoom->parent != $self->currentRegionmap->number
|| $self->selectedRoom->zPosBlocks != $self->currentRegionmap->currentLevel
) {
$self->showMsgDialogue(
'Update character visits',
'info',
'Visits by \'' . $char . '\' to room #' . $self->selectedRoom->number
. ' set to ' . $current,
'ok',
);
}
} else {
# Check every selected room, stopping when we find one on the same level and in the
# same region
OUTER: foreach my $roomObj (@roomList) {
if (! defined $current) {
# (All the selected rooms now have the same number of visits, so $current only
# needs to be set once)
$current = $roomObj->ivShow('visitHash', $char);
if (! $current) {
$current = 0;
}
}
if (
$roomObj->parent == $self->currentRegionmap->number
&& $roomObj->zPosBlocks == $self->currentRegionmap->currentLevel
) {
$matchFlag = TRUE;
last OUTER;
}
}
if (! $matchFlag) {
# No selected rooms are actually visible, so show the confirmation
$self->showMsgDialogue(
'Update character visits',
'info',
'Visits by \'' . $char . '\' in ' . (scalar @roomList) . ' rooms set to '
. $current,
'ok',
);
}
}
return 1;
}
sub toggleGraffitiCallback {
# Called by $self->enableRoomsColumn, ->enableRoomsPopupMenu and ->drawMiscButtonSet
# Toggles graffiti in the selected room(s)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (@roomList, @drawList);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->toggleGraffitiCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (! $self->selectedRoom && ! $self->selectedRoomHash)
|| ! $self->graffitiModeFlag
) {
return undef;
}
# Get a list of selected room(s)
@roomList = $self->compileSelectedRooms();
foreach my $roomObj (@roomList) {
push (@drawList, 'room', $roomObj);
if (! $self->ivExists('graffitiHash', $roomObj->number)) {
$self->ivAdd('graffitiHash', $roomObj->number, undef);
} else {
$self->ivDelete('graffitiHash', $roomObj->number);
}
}
# Redraw the room(s) with graffiti on or off
$self->markObjs(@drawList);
$self->doDraw();
# Update room counts in the window's title bar
$self->setWinTitle();
return 1;
}
sub setFilePathCallback {
# Called by $self->enableRoomsColumn
# Sets the file path for the world's source code file (if known) for the selected room
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# clicks the 'cancel' button on the 'dialogue' window
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($filePath, $virtualPath);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setFilePathCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedRoom) {
return undef;
}
# Prompt the user for the file path, and (optionally) the virtual area path
($filePath, $virtualPath) = $self->promptFilePath($self->selectedRoom);
if (! defined $filePath) {
# User clicked 'cancel' button in the 'dialogue' window
return undef;
} else {
# Modify the world model room
$self->worldModelObj->setRoomSource($self->selectedRoom, $filePath, $virtualPath);
return 1;
}
}
sub setVirtualAreaCallback {
# Called by $self->enableRoomsColumn
# Sets or resets the virtual area path for the selected room(s)
#
# Expected arguments
# $setFlag - Set to TRUE if the rooms' ->virtualAreaPath IV should be set; set to FALSE
# if it should be reset (set to 'undef')
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if there are no
# rooms that can be modified or if the user clicks the 'cancel' button on the
# 'dialogue' window
# 1 otherwise
my ($self, $setFlag, $check) = @_;
# Local variables
my (
$virtualPath, $msg,
@roomList, @useList, @ignoreList,
);
# Check for improper arguments
if (! defined $setFlag || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setVirtualAreaCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Get a list of selected room(s)
@roomList = $self->compileSelectedRooms();
# Check each room to make sure each has a ->sourceCodePath, eliminating those that don't
# (but don't bother in reset mode)
if ($setFlag) {
foreach my $roomObj (@roomList) {
if ($roomObj->sourceCodePath) {
push (@useList, $roomObj);
} else {
push (@ignoreList, $roomObj);
}
}
} else {
# When resetting, use all the selected rooms
@useList = @roomList;
}
if (! @useList) {
$self->showMsgDialogue(
'Set virtual area',
'error',
'Cannot set the virtual area for these rooms (probably because no source code path'
. ' has been set for them)',
'ok',
);
return undef;
}
# Set the virtual area for the selected room(s)
if ($setFlag) {
if (@useList == 1) {
$msg = 'Set the path to the virtual area file for one selected room';
} else {
$msg = 'Set the path to the virtual area file for ' . @roomList
. ' of the selected rooms';
}
# Prompt the user for the virtual area path
$virtualPath = $self->showEntryDialogue(
'Set virtual area',
$msg,
undef, # No maximum number of characters
$self->worldModelObj->lastVirtualAreaPath,
);
if (! defined $virtualPath) {
# User clicked 'cancel' button in the 'dialogue' window
return undef;
} else {
# Set the virtual area paths
foreach my $roomObj (@useList) {
# (Keep the existing value of the room's ->sourceCodePath IV)
$self->worldModelObj->setRoomSource(
$roomObj,
$roomObj->sourceCodePath,
$virtualPath,
);
}
# Display a confirmation
if (@useList == 1) {
$msg = 'one selected room';
} else {
$msg = scalar @useList . ' of the selected rooms';
}
$self->showMsgDialogue(
'Set virtual area',
'info',
'Set the virtual area file for ' . $msg . ' to: ' . $virtualPath,
'ok',
);
}
# Reset the virtual area for the selected room(s)
} else {
# Reset the virtual area paths
foreach my $roomObj (@roomList) {
# (Keep the existing value of the room's ->sourceCodePath IV)
$self->worldModelObj->setRoomSource(
$roomObj,
$roomObj->sourceCodePath,
undef, # No virtual path
);
}
# Display a confirmation
if (@useList == 1) {
$msg = 'the selected room';
} else {
$msg = scalar @roomList . ' selected rooms';
}
# Display a confirmation
$self->showMsgDialogue(
'Reset virtual area',
'info',
'The virtual area file for ' . $msg . ' has been reset',
'ok',
);
}
return 1;
}
sub editFileCallback {
# Called by $self->enableRoomsColumn
# Opens the mudlib file corresponding to the selected room in Axmud's external text editor
# (the one specified by GA::Client->textEditCmd)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $virtualFlag - If set to TRUE, we need to edit the file stored in the room object's
# ->virtualAreaPath. If set to FALSE (or 'undef'), we need to edit the
# file stored in $obj->sourceCodePath
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if no external
# text editor is specified by the GA::Client
# 1 otherwise
my ($self, $virtualFlag, $check) = @_;
# Local variables
my ($cmd, $file);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->editFileCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedRoom
|| (
! defined $virtualFlag
&& (! $self->selectedRoom->sourceCodePath || $self->selectedRoom->virtualAreaPath)
) || (defined $virtualFlag && ! $self->selectedRoom->virtualAreaPath)
) {
return undef;
}
# Check that the GA::Client has a text editor command set, and that it is valid
$cmd = $axmud::CLIENT->textEditCmd;
if (! $cmd || ! ($cmd =~ m/%s/)) {
# Show a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Edit source code file',
'error',
'Can\'t edit the file: invalid external application command \'' . $cmd . '\'',
'ok',
);
return undef;
}
# Set the file to be opened. If the current world model defines a mudlib directory, the
# object's ->mudlibPath is relative to that; otherwise it's an absolute path
if ($self->session->worldModelObj->mudlibPath) {
$file = $self->session->worldModelObj->mudlibPath;
} else {
$file = '';
}
if ($virtualFlag) {
$file .= $self->selectedRoom->virtualAreaPath;
} else {
$file .= $self->selectedRoom->sourceCodePath;
}
# Add the file extension, if set
if ($self->session->worldModelObj->mudlibExtension) {
$file .= $self->session->worldModelObj->mudlibExtension;
}
# Check the file exists
if (! (-e $file)) {
$self->showMsgDialogue(
'Edit source code file',
'error',
'Can\'t find the file \'' . $file . '\'',
'ok',
);
return undef;
}
# Open the file in the external text editor
$cmd =~ s/%s/$file/;
system $cmd;
return 1;
}
sub deleteRoomsCallback {
# Called by $self->enableRoomsColumn
# If multiple rooms are selected, prompts the user before deleting them (there is no
# confirmation prompt if a single room is selected)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user
# changes their mind or if the deletion operation fails
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $result;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->deleteRoomsCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Prompt the user for confirmation before deleting any rooms
if ($self->selectedRoom) {
$result = $self->showMsgDialogue(
'Delete rooms',
'question',
'Are you sure you want to delete the selected room?',
'yes-no',
);
} else {
$result = $self->showMsgDialogue(
'Delete rooms',
'question',
'Are you sure you want to delete ' . $self->ivPairs('selectedRoomHash')
. ' rooms?',
'yes-no',
);
}
if ($result ne 'yes') {
return undef;
} else {
# Delete the selected room(s)
return $self->worldModelObj->deleteRooms(
$self->session,
TRUE, # Update Automapper windows now
$self->compileSelectedRooms(),
);
}
}
sub addContentsCallback {
# Called by $self->enableRoomsColumn
# Adds a non-model object (or objects) from the Locator's current room to the world model,
# making them children of (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, if the Locator task
# isn't running or doesn't know the current location, if its room's temporary contents
# list is empty or if an attempt to parse a string fails
# 1 otherwise
my ($self, $parseFlag, $check) = @_;
# Local variables
my (
$taskObj, $roomObj, $string, $allString, $choice,
@tempList, @useList, @comboList, @addList,
%comboHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addContentsCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (
(! $parseFlag && ! $self->mapObj->currentRoom)
|| ($parseFlag && ! $self->selectedRoom)
)
) {
return undef;
}
if (! $parseFlag) {
# The list of objects should be taken from the Locator task's current room. Import the
# Locator task
$taskObj = $self->session->locatorTask;
# Check the Locator task exists and that it knows about the character's current
# location
if (! $taskObj || ! $taskObj->roomObj) {
# Show a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Add contents',
'error',
'Either the Locator task isn\'t running or it doesn\'t know the current'
. ' location',
'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 contents',
'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) = @_;
# Local variables
my (
$taskObj, $roomObj, $string, $obtainCmd, $choice,
@tempList, @useList, @comboList,
%comboHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addHiddenObjCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (
(! $parseFlag && ! $self->mapObj->currentRoom)
|| ($parseFlag && ! $self->selectedRoom)
)
) {
return undef;
}
if (! $parseFlag) {
# The list of objects should be taken from the Locator task's current room. Import the
# Locator task
$taskObj = $self->session->locatorTask;
# Check the Locator task exists and that it knows about the character's current
# location
if (! $taskObj || ! $taskObj->roomObj) {
# Show a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Add hidden object',
'error',
'Either the Locator task isn\'t running or it doesn\'t know the current'
. ' location',
'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',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->mapObj->currentRoom) {
return undef;
}
# Prompt the user for a search term (e.g. 'fireplace') and the result (e.g.
# 'It's a dirty old fireplace')
($term, $result) = $self->showDoubleEntryDialogue(
'Add search result',
'Add a search term (e.g. \'fireplace\')',
'Add the result (e.g. \'It\'s an old fireplace.\')',
);
if ($term && $result) {
# Add the search term and result to the current room's search hash, replacing the entry
# for the same search term, if it already exists
$self->worldModelObj->addSearchTerm($self->mapObj->currentRoom, $term, $result);
}
return 1;
}
sub setRoomTagCallback {
# Called by $self->enableRoomsColumn
# Sets (or resets) the selected room's room tag
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the supplied tag
# is invalid or if the user declines to reassign an existing room tag
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($roomObj, $tag, $oldRoomNum, $oldRoomObj, $text, $regionObj, $result);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setRoomTagCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomTag)) {
return undef;
}
# Decide which room to use. If there's a single selected room; use it. If there's a single
# selected room tag, use its parent room
if ($self->selectedRoom) {
$roomObj = $self->selectedRoom;
} elsif ($self->selectedRoomTag) {
# (The IV stores the blessed reference of the room tag's parent room)
$roomObj = $self->selectedRoomTag;
}
# Prompt the user for a tag
$tag = $self->showEntryDialogue(
'Set room tag',
'Enter the selected room\'s tag (or leave empty to delete a tag)',
undef, # No maximum number of characters
$roomObj->roomTag,
);
if (defined $tag) {
if (! $tag) {
# Reset the room's tag. The TRUE argument instructs the world model to update its
# Automapper windows
$self->worldModelObj->resetRoomTag(TRUE, $roomObj);
} else {
# Check the tag is valid
if (length($tag) > 16) {
$self->showMsgDialogue(
'Set room tag',
'error',
'Invalid room tag \'' . $tag . '\' - max size 16 characters',
'ok',
);
return undef;
} elsif ($tag =~ m/@@@/) {
$self->showMsgDialogue(
'Set room tag',
'error',
'Invalid room tag \'' . $tag . '\' - tag must not contain \'@@@\'',
'ok',
);
return undef;
}
# If the tag already belongs to another room, it gets reassigned to this one
# If the other room is on the map, but is not currently visible, it won't be obvious
# to the user that the tag has been reassigned, rather than created
# Prompt the user before reassigning a tag from one mapped room to another (but
# don't prompt if the old and new room are the same!)
$oldRoomNum = $self->worldModelObj->checkRoomTag($tag);
if (defined $oldRoomNum && $oldRoomNum != $roomObj->number) {
# Prepare the text to show
$oldRoomObj = $self->worldModelObj->ivShow('modelHash', $oldRoomNum);
$text = 'The tag \'' . $oldRoomObj->roomTag . '\' is already assigned to room #'
. $oldRoomNum;
if (
$self->currentRegionmap
&& $self->currentRegionmap->number eq $oldRoomObj->parent
) {
$text .= ' in this region. ';
} else {
$regionObj = $self->worldModelObj->ivShow('modelHash', $oldRoomObj->parent);
$text .= ' in the region \'' . $regionObj->name . '\'. ';
}
$text .= 'Do you want to reassign it?';
# Prompt the user
$result = $self->showMsgDialogue(
'Reassign room tag',
'question',
$text,
'yes-no',
);
if ($result eq 'no') {
return undef;
}
}
# Set the room's tag
$self->worldModelObj->setRoomTag(TRUE, $roomObj, $tag);
# If the Locator task is running, update it
$self->mapObj->updateLocator();
}
}
return 1;
}
sub setRoomGuildCallback {
# Called by $self->enableRoomsColumn
# Sets a room's guild (->roomGuild)
#
# 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 (
$noGuildString, $msg, $choice, $guildName,
@profList, @sortedList, @comboList, @selectedList, @finalList,
%comboHash, %itemHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setRoomGuildCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (
! $self->selectedRoom && ! $self->selectedRoomHash && ! $self->selectedRoomGuild
&& ! $self->selectedRoomGuildHash
)
) {
return undef;
}
# Compile a list of guild profiles and sort alphabetically
foreach my $profObj ($self->session->ivValues('profHash')) {
if ($profObj->category eq 'guild') {
push (@profList, $profObj);
}
}
@sortedList = sort {lc($a->name) cmp lc($b->name)} (@profList);
# Prepare a list to show in a combo box. At the same time, compile a hash in the form:
# $hash{combo_box_string} = blessed_reference_of_corresponding_profile
foreach my $profObj (@sortedList) {
push (@comboList, $profObj->name);
$comboHash{$profObj->name} = $profObj;
}
# Put an option to use no guild at the top of the combo list
$noGuildString = '<room not a guild>';
unshift (@comboList, $noGuildString);
if ($self->selectedRoom) {
$msg = 'selected room';
if ($self->selectedRoom->roomGuild) {
$msg .= "\n(currently set to \'" . $self->selectedRoom->roomGuild . "\')";
}
} elsif ($self->selectedRoomGuild) {
$msg = "selected room guild\n(currently set to \'" . $self->selectedRoomGuild->roomGuild
. "\')";
} else {
$msg = 'selected rooms';
}
# Prompt the user for a profile
$choice = $self->showComboDialogue(
'Select room guild',
'Select the guild for the ' . $msg,
\@comboList,
);
if ($choice) {
# Convert $choice into a guild profile name
if ($choice eq $noGuildString) {
$guildName = undef; # Room has no guild set
} else {
$guildName = $comboHash{$choice}->name;
}
# Compile a list of selected rooms and selected room guilds
push (@selectedList, $self->compileSelectedRooms(), $self->compileSelectedRoomGuilds());
# Combine them into a single list, @finalList, eliminating duplicate rooms
foreach my $roomObj (@selectedList) {
if (! exists $itemHash{$roomObj->number}) {
push (@finalList, $roomObj);
$itemHash{$roomObj->number} = undef;
}
}
# Update the guild for each room
$self->worldModelObj->setRoomGuild(
TRUE, # Update the Automapper windows now
$guildName, # Name of a guild profile
@finalList,
);
}
return 1;
}
sub resetRoomOffsetsCallback {
# Called by $self->enableRoomsColumn
# Resets the drawn positions (offsets) of the room tags and room guilds for the selected
# room(s)
#
# 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 (
@roomList, @combinedList,
%roomHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->resetRoomOffsetsCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedRoom) {
return undef;
}
# Get a list of selected rooms, room tags and room guilds
push (@roomList,
$self->compileSelectedRooms(),
$self->compileSelectedRoomTags(),
$self->compileSelectedRoomGuilds(),
);
# Combine these lists into a single list of affected rooms, eliminating duplicates and any
# selected room which doesn't have a room tag or a room guild
foreach my $roomObj (@roomList) {
if (
! exists $roomHash{$roomObj->number}
&& ($roomObj->roomTag || $roomObj->roomGuild)
) {
push (@combinedList, $roomObj);
$roomHash{$roomObj->number} = undef;
}
}
# Reset the position of the room tags/room guilds in each affected room (if there are any)
# and instruct the world model to update its Automapper windows
$self->worldModelObj->resetRoomOffsets(
TRUE, # Update Automapper windows now
0, # Mode 0 - reset both room tags and room guilds
@combinedList,
);
return 1;
}
sub setInteriorOffsetsCallback {
# Called by $self->enableRoomsColumn
# Sets the offsets used when a room's grid coordinates are displayed as interior text inside
# the room box
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# doesn't supply a pattern
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($xOffset, $yOffset);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->setInteriorOffsetsCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Prompt the user for a new offsets
($xOffset, $yOffset) = $self->showDoubleEntryDialogue(
'Synchronise grid coordinates',
'Adjust X coordinate (enter an integer)',
'Adjust Y coordinate (enter an integer)',
);
if (
! defined $xOffset
|| ! defined $yOffset
|| ! ($axmud::CLIENT->intCheck($xOffset))
|| ! ($axmud::CLIENT->intCheck($yOffset))
) {
return undef;
} else {
# Update the world model
$self->worldModelObj->setInteriorOffsets($xOffset, $yOffset);
if ($self->worldModelObj->roomInteriorMode eq 'grid_posn') {
# Redraw the current region
$self->redrawRegions();
} else {
# Remind the user how to make the offset position visible, if they aren't already
$self->showMsgDialogue(
'Synchronise grid coordinates',
'info',
'To make grid coordinates visible on the map, click \'View > Room interiors >'
. ' Draw grid coordinates\'',
'ok',
);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
}
sub resetInteriorOffsetsCallback {
# Called by $self->enableRoomsColumn
# Resets the offsets used when a room's grid coordinates are displayed as interior text
# inside the room box
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->resetInteriorOffsetsCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Update the world model
$self->worldModelObj->setInteriorOffsets(0, 0);
if ($self->worldModelObj->roomInteriorMode eq 'grid_posn') {
# Redraw the current region
$self->redrawRegions();
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
sub toggleExclusiveProfileCallback {
# Called by $self->enableRoomsColumn
# Toggles the exclusivity for one or more selected rooms (specifically, toggles the rooms'
# ->exclusiveFlag 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 (
$flagSetting, $mismatchFlag, $msg,
@roomList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->toggleExclusiveProfileCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Get a list of selected rooms
@roomList = $self->compileSelectedRooms();
# Toggle their ->exclusive flags
$self->worldModelObj->toggleRoomExclusivity(
TRUE, # Update Automapper windows now
@roomList,
);
# Compose a message to display. Find out if every room in @roomList has its
# ->exclusiveFlag set to the same value
OUTER: foreach my $roomObj (@roomList) {
if (! defined $flagSetting) {
# This is the first room in @roomList
$flagSetting = $roomObj->exclusiveFlag;
} elsif ($flagSetting != $roomObj->exclusiveFlag) {
# The rooms in @roomList have their ->exclusiveFlag IV set to different values
$mismatchFlag = TRUE;
last OUTER;
}
}
if ($mismatchFlag) {
$msg = 'Toggled exclusivity for ';
if ($self->selectedRoom) {
$msg .= '1 room';
} else {
$msg .= scalar @roomList . ' rooms';
}
} else {
$msg = 'Exclusivity for ';
if ($self->selectedRoom) {
$msg .= '1 room';
} else {
$msg .= scalar @roomList . ' rooms';
}
if ($flagSetting) {
$msg .= ' turned on';
} else {
$msg .= ' turned off';
}
}
$self->showMsgDialogue(
'Toggle exclusive profiles',
'info',
$msg,
'ok',
);
return 1;
}
sub addExclusiveProfileCallback {
# Called by $self->enableRoomsColumn
# Adds a profile to the selected room's exclusive profile hash
#
# 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 (
$choice,
@profList, @sortedList, @finalList, @comboList,
%comboHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addExclusiveProfileCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedRoom) {
return undef;
}
# Get a sorted list of profiles, not including world profiles
foreach my $profObj ($self->session->ivValues('profHash')) {
if ($profObj->category ne 'world') {
push (@profList, $profObj);
}
}
@sortedList = sort {lc($a->name) cmp lc($b->name)} (@profList);
# Remove any profile which is already an exclusive profile for this room
foreach my $profObj (@sortedList) {
if (! $self->selectedRoom->ivExists('exclusiveHash', $profObj->name)) {
push (@finalList, $profObj);
}
}
# Don't prompt for a profile, if there are none available
if (! @finalList) {
return $self->showMsgDialogue(
'Select profile',
'warning',
'Can\'t select a profile - there are none available',
'ok',
);
}
# Prepare a list to show in a combo box. At the same time, compile a hash in the form:
# $hash{combo_box_string} = blessed_reference_to_corresponding_profile
foreach my $profObj (@finalList) {
my $string = $profObj->name . ' [' . $profObj->category . ']';
push (@comboList, $string);
$comboHash{$string} = $profObj;
}
# Prompt the user for a profile
$choice = $self->showComboDialogue(
'Select profile',
'Select a profile which has exclusive access to this room',
\@comboList,
);
if ($choice) {
$self->worldModelObj->setRoomExclusiveProfile(
TRUE, # Update Automapper windows
$self->selectedRoom,
$comboHash{$choice}->name,
);
}
return 1;
}
sub resetExclusiveProfileCallback {
# Called by $self->enableRoomsColumn
# Resets the list of exclusive profiles for the selected rooms
#
# 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 (
$msg,
@roomList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->resetExclusiveProfileCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Get a list of selected rooms
@roomList = $self->compileSelectedRooms();
# Reset their lists of exclusive profiles
$self->worldModelObj->resetExclusiveProfiles(
TRUE, # Update Automapper windows now
@roomList,
);
# Compose a message to display
$msg = 'Reset exclusive profiles for ';
if ($self->selectedRoom) {
$msg .= '1 room';
} else {
$msg .= scalar @roomList . ' rooms';
}
$self->showMsgDialogue(
'Reset exclusive profiles',
'info',
$msg,
'ok',
);
return 1;
}
# Menu 'Exits' column callbacks
sub changeDirCallback {
# Called by $self->enableExitsColumn
# Changes an existing exit's direction and/or its map direction, prompting the user for the
# new directions
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user clicks
# 'cancel' on the 'dialogue' window or if the exit directions can't be changed
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($roomObj, $exitObj, $dir, $mapDir, $result);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->changeDirCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| (
$self->selectedExit->drawMode ne 'primary'
&& $self->selectedExit->drawMode ne 'perm_alloc'
)
) {
return undef;
}
# When a user selects an exit, they may be referring either to the exit stored in
# $self->selectedExit, its twin exit (if there is one) or its shadow exit (if there is
# one). Prompt the user to find out which
$exitObj = $self->promptSpecifyExit('Change direction for which exit?');
if (! $exitObj) {
# User clicked the 'cancel' button, or closed the 'dialogue' window
return undef;
}
# Get the parent room object
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
# If this exit has been allocated a shadow exit, then the 'change direction' operation
# merely reassigns it as an unallocated exit
if ($exitObj->shadowExit) {
$result = $self->worldModelObj->changeShadowExitDir(
$self->session,
TRUE, # Update Automapper windows now
$roomObj,
$exitObj,
);
if (! $result) {
$self->showMsgDialogue(
'Change exit direction',
'warning',
'The exit (which has a shadow exit) could not be reassigned as an unallocated'
. ' exit',
'ok',
);
return undef;
} else {
return 1;
}
# Otherwise, the user needs to specify the new direction
} else {
# Prompt the user for new directions for the exit
($dir, $mapDir) = $self->promptNewExit(
$roomObj,
'Change exit direction',
$exitObj, # Only display widgets to change the nominal & map directions
'change_dir',
);
if (! defined $dir) {
return undef;
}
# Change the exit's direction(s)
$result = $self->worldModelObj->changeExitDir(
$self->session,
TRUE, # Update Automapper windows now
$roomObj,
$exitObj,
$dir,
$mapDir,
);
if (! $result) {
$self->showMsgDialogue(
'Change exit direction',
'warning',
'The exit\'s direction could not be changed',
'ok',
);
return undef;
} else {
return 1;
}
}
}
sub setAltDirCallback {
# Called by $self->enableExitsColumn
# Prompts the user to set an existing exit's alternative nominal directions
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# clicks 'cancel' on the 'dialogue' window
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($exitObj, $choice);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setAltDirCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# When a user selects an exit, they may be referring either to the exit stored in
# $self->selectedExit, its twin exit (if there is one) or its shadow exit (if there is
# one). Prompt the user to find out which
$exitObj = $self->promptSpecifyExit('Set alternative direction(s) for which exit?');
if (! $exitObj) {
# User clicked the 'cancel' button, or closed the 'dialogue' window
return undef;
}
# Prompt the user for the new alternative nominal direction string
$choice = $self->showEntryDialogue(
'Set alternative direction(s)',
'Add one or more alternative directions (or empty the box to reset them)',
undef, # No maximum chars
$exitObj->altDir,
);
if (! defined $choice) {
return undef;
} elsif ($choice eq '') {
$self->worldModelObj->set_exitAltDir($exitObj);
return 1;
} else {
$self->worldModelObj->set_exitAltDir($exitObj, $choice);
return 1;
}
}
sub setAssistedMoveCallback {
# Called by $self->enableExitsColumn
# Adds a key-value pair to an existing exit's ->assistedMoveHash, replacing an old pair if
# necessary
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# clicks 'cancel' in any of the 'dialogue' windows
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($roomObj, $exitObj, $dir, $mapDir, $assistedProf, $assistedMove);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->setAssistedMoveCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| $self->selectedExit->drawMode eq 'temp_alloc'
) {
return undef;
}
# Get the selected exit's parent room object
$roomObj = $self->worldModelObj->ivShow('modelHash', $self->selectedExit->parent);
# When a user selects an exit, they may be referring either to the exit stored in
# $self->selectedExit, its twin exit (if there is one) or its shadow exit (if there is
# one). Prompt the user to find out which
$exitObj = $self->promptSpecifyExit('Set assisted moves for which exit?');
if (! $exitObj) {
# User clicked the 'cancel' button or closed the 'dialogue' window
return undef;
}
# Prompt the user for new assisted move (both $dir and $mapDir will be set to 'undef')
($dir, $mapDir, $assistedProf, $assistedMove) = $self->promptNewExit(
$roomObj,
'Set assisted move',
# Only display widgets to add an assisted move
$exitObj,
'set_assist',
);
if (! defined $assistedMove) {
return undef;
}
# Update the exit. If the user emptied the box (meaning that $assistedMove is an empty
# string), the assisted move for the profile $assistedProf is removed; otherwise an
# assisted move is added
$self->worldModelObj->setAssistedMove($exitObj, $assistedProf, $assistedMove);
return 1;
}
sub allocateMapDirCallback {
# Called by $self->enableExitsColumn
# For an unallocated exit, allocates it a map (primary) direction
#
# 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
my (
$exitObj, $roomObj, $firstComboItem, $number, $extraComboItem, $choice,
@shortList, @longList, @dirList, @comboList, @extraList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->allocateMapDirCallback', @_);
}
# 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
my (
$exitObj, $roomObj, $matchExitObj, $choice,
@shortList, @longList, @dirList, @incomingList, @comboList,
%comboHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->confirmTwoWayCallback',
@_,
);
}
# 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);
# Check the room's list of incoming exits, looking for one which lists $exitObj as its
# potential opposite exit
OUTER: foreach my $otherExit ($roomObj->ivKeys('uncertainExitHash')) {
if ($roomObj->ivShow('uncertainExitHash', $otherExit) == $exitObj->number) {
$matchExitObj = $self->worldModelObj->ivShow('exitModelHash', $otherExit);
last OUTER;
}
}
if (! $matchExitObj) {
# Otherwise, we can compile a list of all the room's incoming and 1-way exits, and ask
# the user to select one of them
OUTER: foreach my $otherExit ($roomObj->ivKeys('uncertainExitHash')) {
push (@incomingList, $self->worldModelObj->ivShow('exitModelHash', $otherExit));
}
OUTER: foreach my $otherExit ($roomObj->ivKeys('oneWayExitHash')) {
push (@incomingList, $self->worldModelObj->ivShow('exitModelHash', $otherExit));
}
if (! @incomingList) {
return $self->showMsgDialogue(
'Confirm two-way exit',
'error',
'There are no incoming uncertain or one-way exits which could be connected'
. ' to the selected exit',
'ok',
);
}
# Prompt the user to select an exit (or to cancel the operation)
foreach my $incomingExitObj (@incomingList) {
my $string
= 'Exit #' . $incomingExitObj->number . ' (' . $incomingExitObj->dir . ')';
# Use a hash, so we can match the user's selected combo item against an exit number
push (@comboList, $string);
$comboHash{$string} = $incomingExitObj;
}
$choice = $self->showComboDialogue(
'Confirm two-way exit',
'Select which incoming exit should be connected to the selected exit',
\@comboList,
);
if (! $choice) {
return undef;
} else {
$matchExitObj = $comboHash{$choice};
}
}
if ($matchExitObj) {
# Allocate the selected exit's ->mapDir permanently
# Update the selected exit and instruct the world model to update its Automapper windows
$self->worldModelObj->setExitMapDir(
$self->session,
FALSE, # Don't update Automapper windows now
$roomObj,
$exitObj,
$axmud::CLIENT->ivShow('constOppDirHash', $matchExitObj->mapDir),
);
# Connect the two exits together
$self->worldModelObj->connectRooms(
$self->session,
TRUE, # Update Automapper windows now
$roomObj,
$self->worldModelObj->ivShow('modelHash', $matchExitObj->parent),
$exitObj->mapDir,
$exitObj->mapDir,
$exitObj,
$matchExitObj,
);
return 1;
} else {
return undef;
}
}
sub allocateShadowCallback {
# Called by $self->enableExitsColumn
# For an unallocated exit, allocates it a shadow exit (which is drawn instead of unallocated
# exit)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if there are no
# exits which can be added as the shadow exit or if the user clicks 'cancel' in the
# 'dialogue' window
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$selectedExitObj, $roomObj, $choice, $shadowExitObj,
@comboList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->allocateShadowCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| (
$self->selectedExit->drawMode ne 'temp_alloc'
&& $self->selectedExit->drawMode ne 'temp_unalloc'
)
) {
return undef;
}
# The currently-selected exit will be unselected before this function finishes, so store a
# local copy of it
$selectedExitObj = $self->selectedExit;
# Get the parent room's blessed reference
$roomObj = $self->worldModelObj->ivShow('modelHash', $selectedExitObj->parent);
# Prepare a list of exits which use either (custom) primary directions, or have been
# allocated to a (standard primary) map direction
OUTER: foreach my $exitNum ($roomObj->ivValues('exitNumHash')) {
my ($exitObj, $string, $customDir);
$exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
# Don't include the currently selected exit, or unallocated exits
if (
($selectedExitObj && $selectedExitObj eq $exitObj)
|| $exitObj->drawMode eq 'temp_alloc'
|| $exitObj->drawMode eq 'temp_unalloc'
) {
next OUTER;
}
# Add a string to the combo
$string = $exitObj->dir . ' #' . $exitObj->number;
if ($exitObj->mapDir) {
# Get the equivalent (custom) primary direction
$customDir = $self->session->currentDict->ivShow(
'primaryDirHash',
$exitObj->mapDir,
);
if ($customDir ne $exitObj->dir) {
$string .= ' <' . $customDir . '>';
}
}
# Add an entry to the hash...
$exitHash{$string} = $exitObj;
# ...and another in the combo list
push (@comboList, $string);
}
# Don't prompt for an exit, if there are none available
if (! @comboList) {
return $self->showMsgDialogue(
'Select shadow',
'error',
'Can\'t allocate a shadow exit - no primary directions are available',
'ok',
);
}
# Prompt the user for a shadow exit
$choice = $self->showComboDialogue(
'Select shadow',
'Choose a shadow exit for \'' . $selectedExitObj->dir . '\'',
\@comboList,
);
if (! $choice) {
return undef;
} else {
$shadowExitObj = $exitHash{$choice};
# Update the exit, and instruct the world model to update its Automapper windows
$self->worldModelObj->setExitShadow(
TRUE, # Update Automapper windows now
$roomObj,
$selectedExitObj,
$shadowExitObj,
);
# Remove this exit's canvas object from the map, first unselecting it
$self->setSelectedObj();
$self->deleteCanvasObj('exit', $selectedExitObj);
# The new selected exit is the shadow (to make it visually clear, what has happened)
$self->setSelectedObj(
[$shadowExitObj, 'exit'],
FALSE, # Select this object; unselect all other objects
);
# DEBUG
if ($axmud::TEST_MODEL_FLAG && ! $self->worldModelObj->testModel($self->session)) {
$self->session->writeDebug(
'ALLOCATE SHADOW MODEL TEST: World model test failed at '
. $axmud::CLIENT->localTime(),
);
$axmud::CLIENT->playSound('alarm');
# Test failed. Don't keep running tests
$axmud::TEST_MODEL_FLAG = FALSE;
}
# DEBUG
return 1;
}
}
sub connectToClickCallback {
# Called by $self->enableExitsColumn
# When the user wants to connect the selected exit, first check whether the exit has a twin
# exit. If so, prompt the user to ask which of the two should be connected;
# $self->selectedExit is then set to the exit specified by the user
# In both cases, set $self->freeClickMode to 'connect_exit'. $self->canvasObjEventHandler
# handles the connection operation
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the user
# declines to specify an exit
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$comboListRef, $exitHashRef, $choice,
@comboList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->connectToClickCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| $self->selectedExit->drawMode eq 'temp_alloc'
) {
return undef;
}
# If the exit has a twin exit and/or a shadow exit, we need to prompt the user to ask which
# of them should be edited
if ($self->selectedExit->twinExit || $self->selectedExit->shadowExit) {
($comboListRef, $exitHashRef) = $self->compileExitList();
if (! defined $comboListRef) {
return undef;
}
@comboList = @$comboListRef;
%exitHash = %$exitHashRef;
# Prompt the user to choose which exit to edit
$choice = $self->showComboDialogue(
'Select exit',
'Select which exit to connect',
\@comboList,
);
if (! $choice) {
return undef;
} else {
# Change the selected exit to the one specified by the user
$self->setSelectedObj(
[$exitHash{$choice}, 'exit'],
FALSE, # Select this object; unselect all other objects
);
}
}
# Set ->freeClickMode; $self->canvasObjEventHandler will connect the exit to the room
# clicked on by the user
$self->set_freeClickMode('connect_exit');
return 1;
}
sub disconnectExitCallback {
# Called by $self->enableExitsColumn
# Disconnects the selected exit. If the exit has a twin exit, that is disconnected, too
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->disconnectExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# Perform the disconnection
if (
! $self->worldModelObj->disconnectExit(
TRUE, # Update Automapper windows now
$self->selectedExit,
)
) {
# Not a connected exit
$self->showMsgDialogue(
'Disconnect exit',
'error',
'The selected exit (#' . $self->selectedExit->number
. ') is not connected to a room',
'ok',
);
} else {
# If a twin exit was selected, there are now two incomplete exits, one selected, the
# other not. Unselect both because that looks odd
$self->setSelectedObj();
}
return 1;
}
sub exitOrnamentCallback {
# Called by $self->enableExitsColumn
# Sets (or resets) the ornament for the selected exit or exits
# When there's a single selected exit, prompts the user whether the ornament should be
# added to an exit or to its twin (as appropriate)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $type - The exit ornament type, one of the permitted values for
# GA::Obj::Exit->exitOrnament ('none', 'break', 'pick', 'lock', 'open',
# 'impass', 'mystery'). If 'undef', the value 'none' is set
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if there's an error
# prompting the user to choose an exit or if the user cancels that prompt
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my (
$comboListRef, $exitHashRef, $choice, $bothString,
@exitList, @comboList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->exitOrnamentCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedExit && ! $self->selectedExitHash)) {
return undef;
}
# Compile a list of selected exits
@exitList = $self->compileSelectedExits();
# Allow the user to specify both exits, when prompted
$bothString = 'Use both exits';
# If there's only one exit in @exitList - i.e. one exit is selected - we need to prompt
# the user to ask whether the exit or its twin (if is has one) should have their ornaments
# set/reset (but don't bother if the flag to automatically set/reset ornaments for both is
# set to TRUE)
if ($self->selectedExit && $self->selectedExit->twinExit) {
if (! $self->worldModelObj->setTwinOrnamentFlag) {
($comboListRef, $exitHashRef) = $self->compileExitList();
if (! defined $comboListRef) {
return undef;
}
@comboList = ($bothString, @$comboListRef);
%exitHash = %$exitHashRef;
# Prompt the user to choose which exit to use
$choice = $self->showComboDialogue(
'Set ornaments',
'Select which exit should have its ornaments set',
\@comboList,
);
if (! $choice) {
# Don't set an ornament
return undef;
} elsif ($choice eq $bothString) {
# Add the twin exit to @exitList, so that both will have their ornaments set or
# reset
push (
@exitList,
$self->worldModelObj->ivShow(
'exitModelHash',
$self->selectedExit->twinExit,
),
);
} else {
# Replace the only exit in @exitList with the exit selected by the user
@exitList = ($exitHash{$choice});
# Also make this the selected exit
$self->setSelectedObj(
[$exitHash{$choice}, 'exit'],
FALSE, # Select this object; unselect all other objects
);
}
} else {
# Modify both the exit and its twin
push (
@exitList,
$self->worldModelObj->ivShow('exitModelHash', $self->selectedExit->twinExit),
);
}
}
# Update the exits and redraw their parent rooms
$self->worldModelObj->setMultipleOrnaments(
TRUE, # Update Automapper windows now
$type,
@exitList,
);
return 1;
}
sub obscuredRadiusCallback {
# Called by $self->enableViewColumn
# Sets the radius of the area in which rooms have their exits drawn, when
# GA::Obj::WorldModel->obscuredExitFlag or GA::Obj::Regionmap->obscuredExitFlag is set
# (the current room is at the centre of the area)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $regionmapObj - If specified, updates the regionmap IV. If not specified, updates the
# world model IV
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if there's an error
# prompting the user to choose an exit or if the user cancels that prompt
# 1 otherwise
my ($self, $regionmapObj, $check) = @_;
# Local variables
my ($title, $msg, $radius);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->obscuredRadiusCallback',
@_,
);
}
# (No standard callback checks for this function)
$title = 'Set obscure exit radius';
$msg = 'Set the size of the unobscured area around the current room (1-'
. $self->worldModelObj->maxObscuredExitRadius . ', currently set to ';
if ($regionmapObj) {
$title .= ' (' . $regionmapObj->name . ')';
$msg .= $regionmapObj->obscuredExitRadius . ')',
} else {
$msg .= $self->worldModelObj->obscuredExitRadius . ')',
}
# Prompt the user for a radius
$radius = $self->showEntryDialogue($title, $msg);
if ($radius) {
# Check that $radius is a valid integer, in the permitted range
if (
! ($radius =~ /\D/)
&& $radius > 1
&& $radius <= $self->worldModelObj->maxObscuredExitRadius
) {
if ($regionmapObj) {
$regionmapObj->ivPoke('obscuredExitRadius', $radius);
} else {
$self->worldModelObj->set_obscuredExitRadius($radius);
}
} else {
# Show an explanatory message
$self->showMsgDialogue(
$title,
'error',
'Invalid value for radius - must be an integer between 1 and '
. $self->worldModelObj->maxObscuredExitRadius,
'ok',
);
}
}
return 1;
}
sub hiddenExitCallback {
# Called by $self->enableExitsColumn
# Hides or unhides the currently selected exit. If the selected exit could be confused with
# others occupying (roughly) the same space, opens a 'dialogue' window so the user can
# choose one
#
# Expected arguments
# $hiddenFlag - If set to TRUE, the selected exit is marked as hidden. If set to FALSE,
# the selected exit is marked as not hidden
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $hiddenFlag, $check) = @_;
# Local variables
my (
$bothString, $allString, $stringListRef, $exitHashRef, $text, $choice, $msg,
@stringList, @comboList, @finalList,
%exitHash,
);
# Check for improper arguments
if (! defined $hiddenFlag || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->hiddenExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# Possible initial combo items
if ($hiddenFlag) {
$bothString = '<hide both>';
$allString = '<hide all>';
} else {
$bothString = '<unhide both>';
$allString = '<unhide all>';
}
# If the exit has a twin exit and/or a shadow exit, we need to prompt the user to ask which
# of them should be hidden/unhidden
if ($self->selectedExit->twinExit || $self->selectedExit->shadowExit) {
($stringListRef, $exitHashRef) = $self->compileExitList();
if (! defined $stringListRef) {
return undef;
}
@stringList = @$stringListRef;
%exitHash = %$exitHashRef;
# Compile the combo list
if (@stringList == 2) {
@comboList = ($bothString, @stringList);
} elsif (@stringList > 2) {
@comboList = ($allString, @stringList);
} else {
@comboList = @stringList;
}
# Prompt the user to choose which exit to hide
if ($hiddenFlag) {
$text = 'Select which exit to hide';
} else {
$text = 'Select which exit to unhide';
}
$choice = $self->showComboDialogue(
'Select exit',
$text,
\@comboList,
);
if (! $choice) {
return undef;
} elsif ($choice eq $bothString || $choice eq $allString) {
@finalList = values %exitHash;
} else {
push (@finalList, $exitHash{$choice});
# Change the selected exit to the one specified by the user
$self->setSelectedObj(
[$exitHash{$choice}, 'exit'],
FALSE, # Select this object; unselect all other objects
);
}
} else {
# The selected exit has no twin/shadow, so simply hide/undhide it
push (@finalList, $self->selectedExit);
}
# Hide/unhide the exit object(s). There aren't going to be many exits in @finalList, so it's
# not so inefficient to make a separate call to the world model for every exit
foreach my $exitObj (@finalList) {
$self->worldModelObj->setHiddenExit(
TRUE, # Update Automapper windows now
$exitObj,
$hiddenFlag,
);
}
# Display a confirmation, since many exits aren't visible
if (@finalList) {
if (scalar @finalList == 1) {
$msg = '1 exit (#' . $finalList[0]->number . ')';
} else {
$msg = scalar @finalList . ' exits';
}
if ($hiddenFlag) {
$msg .= ' marked \'hidden\'';
} else {
$msg .= ' marked \'not hidden\'';
}
$self->showMsgDialogue(
'Mark hidden exit',
'info',
$msg,
'ok',
);
}
return 1;
}
sub markBrokenExitCallback {
# Called by $self->enableExitsColumn
# Marks the selected exit and its twin exit (if any) as broken exits (unless they are
# already broken exits or region exits, or if the selected exit doesn't have a destination
# room)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the exit(s)
# can't be marked as broken
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($text, $twinExitObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->markBrokenExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# Basic checks
if ($self->selectedExit->brokenFlag) {
$text = 'The selected exit is already a broken exit';
} elsif ($self->selectedExit->regionFlag) {
$text = 'Region exits can\'t be marked as broken exits';
} elsif ($self->selectedExit->randomType ne 'none') {
$text = 'Random exits can\'t be marked as broken exits';
} elsif (! $self->selectedExit->destRoom) {
$text = 'The selected exit doesn\'t have a destination room';
}
if ($text) {
$self->showMsgDialogue(
'Mark exit as broken',
'error',
$text,
'ok',
);
return undef;
}
# Mark the exit as broken and instruct the world model to update its Automapper windows
$self->worldModelObj->setBrokenExit(
TRUE, # Update Automapper windows now
$self->selectedExit,
);
# If the selected exit has a twin exit, that must also be marked as broken
if ($self->selectedExit->twinExit) {
$twinExitObj
= $self->worldModelObj->ivShow('exitModelHash', $self->selectedExit->twinExit);
$self->worldModelObj->setBrokenExit(
TRUE, # Update Automapper windows now
$twinExitObj,
);
}
return 1;
}
sub restoreBrokenExitCallback {
# Called by $self->enableExitsColumn
# Checks whether the selected broken exit (and its twin exit, if there is one) can now
# be marked as unbroken. If so, redraws them
# This might be used in conjunction with the 'mark exit as broken' operation
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the selected
# broken exit can't be restored
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($text, $twinExitObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->restoreBrokenExitCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# Basic checks
if (! $self->selectedExit->brokenFlag) {
$text = 'The selected exit is not marked as broken';
} elsif (! $self->worldModelObj->checkRoomAlignment($self->session, $self->selectedExit)) {
$text = 'The selected broken exit can\'t be restored';
}
if ($text) {
$self->showMsgDialogue(
'Restore broken exit',
'error',
$text,
'ok',
);
return undef;
}
# Mark the exit as not broken
$self->worldModelObj->restoreBrokenExit(
$self->session,
TRUE, # Update Automapper windows now
$self->selectedExit,
TRUE, # We've already called ->checkRoomAlignment
);
# If the exit has a twin exit, that must also be marked as not broken
if ($self->selectedExit->twinExit) {
$twinExitObj
= $self->worldModelObj->ivShow('exitModelHash', $self->selectedExit->twinExit);
$self->worldModelObj->restoreBrokenExit(
$self->session,
TRUE, # Update Automapper windows now
$twinExitObj,
TRUE, # We've already called ->checkRoomAlignment
);
}
return 1;
}
sub markOneWayExitCallback {
# Called by $self->enableExitsColumn
# Marks the selected exit as a one-way exit (assuming it's currently an uncertain or
# two-way exit)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the exit(s)
# can't be marked as one-way
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$stringListRef, $exitHashRef, $choice, $exitObj, $msg,
@stringList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->markOneWayExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# If the exit has a twin exit and/or a shadow exit, we need to prompt the user to ask which
# of them should be marked as one-way
if ($self->selectedExit->twinExit || $self->selectedExit->shadowExit) {
($stringListRef, $exitHashRef) = $self->compileExitList();
if (! defined $stringListRef) {
return undef;
}
@stringList = @$stringListRef;
%exitHash = %$exitHashRef;
# Prompt the user to choose which exit to convert
$choice = $self->showComboDialogue(
'Select exit',
'Select which exit to make one-way',
\@stringList,
);
if (! $choice) {
return undef;
} else {
$exitObj = $exitHash{$choice};
# Also make this the selected exit
$self->setSelectedObj(
[$exitHash{$choice}, 'exit'],
FALSE, # Select this object; unselect all other objects
);
}
} else {
# The selected exit has no twin/shadow
$exitObj = $self->selectedExit;
}
# Basic checks
if ($exitObj->oneWayFlag) {
$msg = 'The selected exit is already a one-way exit';
} elsif ($exitObj->drawMode eq 'temp_alloc' || $exitObj->drawMode eq 'temp_unalloc') {
$msg = 'Unallocated exits can\'t be marked as one-way exits';
} elsif (! $exitObj->destRoom && $exitObj->randomType eq 'none') {
$msg = 'Incomplete exits (which have no destination room) can\'t be marked as one-way'
. ' exits';
}
if ($msg) {
$self->showMsgDialogue(
'Mark exit as one-way',
'error',
$msg,
'ok',
);
return undef;
}
# Mark this exit as a one-way exit and instruct the world model to update its Automapper
# windows
$self->worldModelObj->markOneWayExit(
TRUE, # Update Automapper windows now
$exitObj,
);
# Show a confirmation dialogue
$self->showMsgDialogue(
'Mark exit as one-way',
'info',
'Exit #' . $exitObj->number . ' converted to a one-way exit',
'ok',
);
return 1;
}
sub restoreOneWayExitCallback {
# Called by $self->enableExitsColumn
# Checks whether the selected one-way exit can be marked as uncertain or two-way. If so,
# redraws them
# This might be used in conjunction with the 'mark exit as one-way' operation
#
# Expected arguments
# $twoWayFlag - Set to TRUE if the one-way exit should be converted into a two-way
# exit (if possible); set to FALSE if it should be converted into an
# uncertain exit (if possible)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the selected
# exit isn't one-way or if there isn't an exit in the opposite direction, potentially
# leading back from the destination room, which we need to form a two-way or uncertain
# exit
# 1 otherwise
my ($self, $twoWayFlag, $check) = @_;
# Local variables
my ($msg, $oppExitObj, $title, $roomObj, $oppRoomObj);
# Check for improper arguments
if (! defined $twoWayFlag || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->restoreOneWayExitCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# Basic checks
if (! $self->selectedExit->oneWayFlag) {
$msg = 'The selected exit is not marked as one-way';
} else {
# See if the destination room has an exit in the opposite direction to the selected
# one-way exit
$oppExitObj = $self->worldModelObj->checkOppPrimary($self->selectedExit);
if (! $oppExitObj) {
$msg = ' because there is no exit in the opposite direction';
} elsif (
$oppExitObj->drawMode eq 'temp_alloc'
|| $oppExitObj->drawMode eq 'temp_unalloc'
) {
$msg = ' because the exit, apparently in the opposite direction, hasn\'t yet'
. ' been allocated that direction permanently',
} elsif ($oppExitObj->destRoom) {
$msg = ' because the opposite exit already has a destination room';
}
if ($msg) {
if ($twoWayFlag) {
$msg = 'The selected exit can\'t be marked as two-way' . $msg;
} else {
$msg = 'The selected exit can\'t be marked as uncertain' . $msg;
}
}
}
if ($msg) {
if ($twoWayFlag) {
$title = 'Restore two-way exit';
} else {
$title = 'Restore uncertain exit';
}
$self->showMsgDialogue(
$title,
'error',
$msg,
'ok',
);
return undef;
}
# Get the parent rooms
$roomObj = $self->worldModelObj->ivShow('modelHash', $self->selectedExit->parent);
$oppRoomObj = $self->worldModelObj->ivShow('modelHash', $oppExitObj->parent);
if ($twoWayFlag) {
# Connect the opposite exit to the selected exit, thereby establishing a two-way exit
$self->worldModelObj->connectRooms(
$self->session,
TRUE, # Update Automapper windows now
$oppRoomObj,
$roomObj,
$oppExitObj->dir,
$oppExitObj->mapDir,
$oppExitObj,
);
} else {
# Convert the one-way exit into an uncertain exit
$self->worldModelObj->convertOneWayExit(
TRUE, # Update Automapper windows now
$self->selectedExit,
$oppRoomObj,
$oppExitObj,
);
}
# Display a confirmation
$msg = 'Exit #' . $self->selectedExit->number . ' restored to';
if ($twoWayFlag) {
$msg .= ' a two-way exit';
$title = 'Restore two-way exit';
} else {
$msg .= ' an uncertain exit';
$title = 'Restore uncertain exit';
}
$self->showMsgDialogue(
$title,
'info',
$msg,
'ok',
);
return 1;
}
sub markRetracingExitCallback {
# Called by $self->enableExitsColumn
# Marks the selected exit as a retracing exit (a special kind of one-way exit which leads
# back to the same room)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the exit(s)
# can't be marked as retracing
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$comboListRef, $exitHashRef, $choice, $exitObj, $roomObj, $result,
@comboList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->markRetracingExitCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# If the selected exit has a twin exit and/or a shadow exit, we need to prompt the user to
# ask which of them should be modified
if ($self->selectedExit->twinExit || $self->selectedExit->shadowExit) {
($comboListRef, $exitHashRef) = $self->compileExitList();
if (! defined $comboListRef) {
return undef;
}
@comboList = @$comboListRef;
%exitHash = %$exitHashRef;
# Prompt the user to choose which exit to edit
$choice = $self->showComboDialogue(
'Select exit',
'Select which exit to modify',
\@comboList,
);
if (! $choice) {
return undef;
} else {
$exitObj = $exitHash{$choice};
# Also make this the selected exit
$self->setSelectedObj(
[$exitHash{$choice}, 'exit'],
FALSE, # Select this object; unselect all other objects
);
}
} else {
$exitObj = $self->selectedExit;
}
# Basic checks
if ($exitObj->retraceFlag) {
$self->showMsgDialogue(
'Mark exit as retracing',
'error',
'The selected exit is already a retracing exit',
'ok',
);
return undef;
}
# Connect the selected exit to its own parent room
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
$result = $self->worldModelObj->connectRooms(
$self->session,
TRUE, # Update Automapper windows now
$roomObj,
$roomObj,
$exitObj->dir,
$exitObj->mapDir,
$exitObj,
);
# Display a confirmation
if (! $result) {
$self->showMsgDialogue(
'Mark exit as retracing',
'error',
'Could not convert exit #' . $exitObj->number . ' to a retracing exit',
'ok',
);
return undef;
} else {
return 1;
}
}
sub restoreRetracingExitCallback {
# Called by $self->enableExitsColumn
# Converts the selected retracing exit into an incomplete exit
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the selected
# exit isn't a retracing exit
# 1 otherwise
my ($self, $check) = @_;
# Local variables
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->restoreRetracingExitCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# Basic checks
if (! $self->selectedExit->retraceFlag) {
$self->showMsgDialogue(
'Restore incomplete exit',
'error',
'The selected exit is not marked as a retracing exit',
'ok',
);
return undef;
} else {
# Convert the exit to an incomplete exit
$self->worldModelObj->restoreRetracingExit(
TRUE, # Update Automapper windows now
$self->selectedExit,
);
return 1;
}
}
sub markRandomExitCallback {
# Called by $self->enableExitsColumn
# Marks the selected exit as a random exit (assuming it's currently an incomplete exit)
#
# Expected arguments
# $exitType - Set to 'same_region' if the exit leads to a random location in the current
# region, 'any_region' if the exit leads to a random location in any
# region, 'temp_region' if a destination should be created in a new
# temporary region, or 'room_list' if the exit leads to a random location
# in its ->randomDestList
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user
# declines to specify which of two possible exits to modify or if the specified exit
# is already a random exit
# 1 otherwise
my ($self, $exitType, $check) = @_;
# Local variables
my (
$comboListRef, $exitHashRef, $choice, $exitObj,
@comboList,
%exitHash,
);
# Check for improper arguments
if (
! defined $exitType
|| (
$exitType ne 'same_region' && $exitType ne 'any_region'
&& $exitType ne 'temp_region' && $exitType ne 'room_list'
)
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->markRandomExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# If the selected exit has a twin exit and/or a shadow exit, we need to prompt the user to
# ask which of them should be modified
if ($self->selectedExit->twinExit || $self->selectedExit->shadowExit) {
($comboListRef, $exitHashRef) = $self->compileExitList();
if (! defined $comboListRef) {
return undef;
}
@comboList = @$comboListRef;
%exitHash = %$exitHashRef;
# Prompt the user to choose which exit to edit
$choice = $self->showComboDialogue(
'Select exit',
'Select which exit to modify',
\@comboList,
);
if (! $choice) {
return undef;
} else {
$exitObj = $exitHash{$choice};
# Also make this the selected exit
$self->setSelectedObj(
[$exitHash{$choice}, 'exit'],
FALSE, # Select this object; unselect all other objects
);
}
} else {
$exitObj = $self->selectedExit;
}
# Basic checks
if ($exitObj->randomType ne 'none' && $exitObj->randomType eq $exitType) {
$self->showMsgDialogue(
'Mark exit as random',
'warning',
'The selected exit is already marked as random (type \'' . $exitType . '\')',
'ok',
);
return undef;
} else {
# Mark the exit as random, and instruct the world model to updates its Automapper
# windows
$self->worldModelObj->setRandomExit(
TRUE, # Update Automapper windows now
$exitObj,
$exitType,
);
return 1;
}
}
sub restoreRandomExitCallback {
# Called by $self->enableExitsColumn
# Converts the selected random exit into an incomplete exit
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the selected
# exit isn't a random exit
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->restoreRandomExitCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# Basic checks
if ($self->selectedExit->randomType eq 'none') {
$self->showMsgDialogue(
'Restore random exit',
'error',
'The selected exit is not marked as a random exit',
'ok',
);
return undef;
} else {
$self->worldModelObj->restoreRandomExit(
TRUE, # Update Automapper windows now
$self->selectedExit,
);
return 1;
}
}
sub markSuperExitCallback {
# Called by $self->enableExitsColumn
# Marks the selected exit as a super-region exit (assuming it's currently an ordinary
# region exit)
#
# Expected arguments
# $exclusiveFlag - Set to TRUE if this should be the only super-region exit leading from
# its parent region to its destination region. Set to FALSE if other
# super-region exits between the two regions (if any) can be left as
# super-region exits
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user
# declines to specify which of two possible exits to modify or if the specified exit
# isn't a region exit
# 1 otherwise
my ($self, $exclusiveFlag, $check) = @_;
# Local variables
my (
$bothString, $allString, $stringListRef, $exitHashRef, $choice, $confirmFlag, $msg,
$title,
@stringList, @comboList, @finalList,
%exitHash,
);
# Check for improper arguments
if (! defined $exclusiveFlag || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->markSuperExitCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| ! $self->selectedExit->regionFlag
) {
return undef;
}
# Possible initial combo items
$bothString = '<modify both>';
$allString = '<modify all>';
# Compile a list of exits which could be confused with the currently selected one
($stringListRef, $exitHashRef) = $self->compileExitList();
if (! defined $stringListRef) {
return undef;
}
@stringList = @$stringListRef;
%exitHash = %$exitHashRef;
# If there is more than one exit in the list, prompt the user to specify which one to modify
if (scalar @stringList > 1) {
# Compile the combo list
if (@stringList == 2) {
@comboList = ($bothString, @stringList);
} elsif (@stringList > 2) {
@comboList = ($allString, @stringList);
} else {
@comboList = @stringList;
}
# Prompt the user to choose which exit to modify
$choice = $self->showComboDialogue(
'Select exit',
'Select which exit to modify',
\@comboList,
);
if (! $choice) {
return undef;
} elsif ($choice eq $bothString || $choice eq $allString) {
@finalList = values %exitHash;
} else {
push (@finalList, $exitHash{$choice});
}
} else {
# There's only one exit on which to operate
push (@finalList, $self->selectedExit);
}
foreach my $exitObj (@finalList) {
# Mark the exit as a super-region exit and instruct the world model to update its
# Automapper windows
$self->worldModelObj->setSuperRegionExit(
$self->session,
TRUE, # Update Automapper windows now
$exitObj,
$exclusiveFlag,
);
}
# Show a confirmation
if ($exclusiveFlag) {
$title = 'Mark exclusive super-region exit';
if (@finalList > 1) {
$msg = 'The selected region exits are now exclusive super-region exits';
} else {
$msg = 'The selected region exit is now an exclusive super-region exit';
}
} else {
$title = 'Mark super-region exit';
if (@finalList > 1) {
$msg = 'The selected region exits are now super-region exits';
} else {
$msg = 'The selected region exit is now a super-region exit';
}
}
$self->showMsgDialogue(
$title,
'info',
$msg,
'ok',
);
return 1;
}
sub restoreSuperExitCallback {
# Called by $self->enableExitsColumn
# Converts the selected super-region exit into a normal region exit
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the selected
# exit isn't a super-region exit
# 1 otherwise
my ($self, $check) = @_;
my (
$bothString, $allString, $stringListRef, $exitHashRef, $choice, $msg,
@stringList, @comboList, @finalList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->restoreSuperExitCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| ! $self->selectedExit->regionFlag
) {
return undef;
}
# Possible initial combo items
$bothString = '<modify both>';
$allString = '<modify all>';
# Compile a list of exits which could be confused with the currently selected one
($stringListRef, $exitHashRef) = $self->compileExitList();
if (! defined $stringListRef) {
return undef;
}
@stringList = @$stringListRef;
%exitHash = %$exitHashRef;
# If there is more than one exit in the list, prompt the user to specify which one to modify
if (scalar @stringList > 1) {
# Compile the combo list
if (@stringList == 2) {
@comboList = ($bothString, @stringList);
} elsif (@stringList > 2) {
@comboList = ($allString, @stringList);
} else {
@comboList = @stringList;
}
# Prompt the user to choose which exit to modify
$choice = $self->showComboDialogue(
'Select exit',
'Select which exit to modify',
\@comboList,
);
if (! $choice) {
return undef;
} elsif ($choice eq $bothString || $choice eq $allString) {
@finalList = values %exitHash;
} else {
push (@finalList, $exitHash{$choice});
}
} else {
# There's only one exit on which to operate
push (@finalList, $self->selectedExit);
}
foreach my $exitObj (@finalList) {
# Convert the super-region exit to a normal region exit and instruct the world model to
# update its Automapper windows
$self->worldModelObj->restoreSuperRegionExit(
TRUE, # Update Automapper windows now
$exitObj,
);
}
# Show a confirmation
if (@finalList > 1) {
$msg = 'The selected region exits are now normal region exits';
} else {
$msg = 'The selected region exit is now a normal region exit';
}
$self->showMsgDialogue(
'Convert super-region exit',
'info',
$msg,
'ok',
);
return 1;
}
sub setExitTwinCallback {
# Called by $self->enableExitsColumn
# Twins the selected exit with an exit in the destination room, which in turn leads back to
# the selected exit's room
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if there are no
# suitable exits in the selected exit's destination room, with which it can be
# twinned, if the user declines to select a twin exit, when prompted, or if the
# twinnng operation fails
# 1 otherwise
my ($self, $check) = @_;
my (
$roomObj, $destRoomObj, $choice, $twinExitObj,
@otherExitList, @comboList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setExitTwinCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| (
! $self->selectedExit->oneWayFlag
&& ! (
$self->selectedExit->destRoom
&& ! $self->selectedExit->twinExit
&& ! $self->selectedExit->retraceFlag
&& $self->selectedExit->randomType eq 'none'
)
)
) {
return undef;
}
# Get the exit's parent room and its destination room
$roomObj = $self->worldModelObj->ivShow('modelHash', $self->selectedExit->parent);
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $self->selectedExit->destRoom);
# Get a list of exits in the destination room which lead back to the selected exit's room
# and which are uncertain or one-way exits
foreach my $otherExitNum ($destRoomObj->ivValues('exitNumHash')) {
my $otherExitObj = $self->worldModelObj->ivShow('exitModelHash', $otherExitNum);
if (
$otherExitObj->destRoom
&& $otherExitObj->destRoom == $roomObj->number
&& (
$otherExitObj->oneWayFlag
|| (
! $otherExitObj->twinExit
&& ! $otherExitObj->retraceFlag
&& $otherExitObj->randomType eq 'none'
)
)
) {
push (@otherExitList, $otherExitObj);
}
}
if (! @otherExitList) {
$self->showMsgDialogue(
'Set twin exit',
'error',
'There are no exits in the selected exit\'s destination room which lead back to the'
. ' exit\'s own parent room',
'ok',
);
return undef;
}
# Prompt the user to confirm which exit should be twinned with the selected exit
foreach my $exitObj (@otherExitList) {
my $string = '#' . $exitObj->number . ' ' . $exitObj->dir;
if ($exitObj->shadowExit) {
$string .= ' (shadow of exit #' . $exitObj->shadowExit . ')';
}
push (@comboList, $string);
$exitHash{$string} = $exitObj;
}
$choice = $self->showComboDialogue(
'Set exit twin',
'Select which uncertain/one-way exit to\ntwin with the selected exit \''
. $self->selectedExit->dir . '\'',
\@comboList,
);
if (! $choice) {
return undef;
} else {
$twinExitObj = $exitHash{$choice};
# Twin the two exits together
if (
! $self->worldModelObj->convertToTwinExits(
TRUE, # Update Automapper windows
$self->selectedExit,
$twinExitObj,
)
) {
# Show confirmation
$self->showMsgDialogue(
'Set twin exit',
'error',
'The twinning operation failed',
'ok',
);
return undef;
} else {
# No need to show a confirmation - the Automapper window has been updated
return 1;
}
}
}
sub setIncomingDirCallback {
# Called by $self->enableExitsColumn
# Changes the direction in which the far end of a one-way exit (the end which touches the
# destination room) is drawn
# By default, that direction is the opposite of the exit's ->mapDir, but the user can change
# that direction, if they want
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user
# declines to select a new incoming direction, when prompted, or if the modification
# operation fails
# 1 otherwise
my ($self, $check) = @_;
my (
$oneWayDir, $choice,
@shortList, @longList, @dirList, @otherList, @comboList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setIncomingDirCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| ! $self->selectedExit->oneWayFlag
) {
return undef;
}
# 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(
north northeast east southeast south southwest west northwest up down
northnortheast eastnortheast eastsoutheast southsoutheast
southsouthwest westsouthwest westnorthwest northnorthwest
);
if ($self->worldModelObj->showAllPrimaryFlag) {
@dirList = @longList;
} else {
@dirList = @shortList;
}
# Move the exit's current ->oneWayDir to the top of the list
$oneWayDir = $self->selectedExit->oneWayDir;
foreach my $dir (@dirList) {
if ($oneWayDir eq $dir) {
push (@comboList, $dir);
} else {
push (@otherList, $dir);
}
}
push (@comboList, @otherList);
# Prompt the user for a new incoming direction
$choice = $self->showComboDialogue(
'Set incoming direction',
'Select the direction in which this \'' . $self->selectedExit->dir
. '\' exit is drawn as it approaches its destination room',
\@comboList,
);
if (! $choice) {
return undef;
} else {
# Ask the GA::Obj::WorldModel to change the exit's IV
if (
! $self->worldModelObj->setExitIncomingDir(
TRUE, # Update Automapper windows
$self->selectedExit,
$choice,
)
) {
# Show confirmation
$self->showMsgDialogue(
'Set incoming direction',
'error',
'The operation failed',
'ok',
);
return undef;
} else {
# No need to show a confirmation - the Automapper window has been updated
return 1;
}
}
}
sub toggleExitTagCallback {
# Called by $self->enableExitsColumn
# Toggles the exit tag on the selected exit
#
# 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 $exitObj;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->toggleExitTagCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (
(! $self->selectedExit || ! $self->selectedExit->regionFlag)
&& ! $self->selectedExitTag
)
) {
return undef;
}
# Get the exit to use
if ($self->selectedExit) {
$exitObj = $self->selectedExit;
} else {
$exitObj = $self->selectedExitTag;
}
# Toggle the exit tag
if (! $exitObj->exitTag) {
$self->worldModelObj->applyExitTag(
TRUE, # Update Automapper windows now
$exitObj,
);
} else {
$self->worldModelObj->cancelExitTag(
TRUE, # Update Automapper windows now
$exitObj,
);
}
# For a selected exit tag - which has now been removed - select the exit instead
$self->setSelectedObj(
[$exitObj, 'exit'],
FALSE, # Select this object; unselect all other objects
);
return 1;
}
sub viewExitDestination {
# Called by $self->enableExitTagsPopupMenu (only)
# For a region exit, selects the destination room and changes the currently displayed region
# (and level) to show it
#
# 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 $roomObj;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->viewExitDestination', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExitTag) {
return undef;
}
# Get the exit's destination room
$roomObj = $self->worldModelObj->ivShow('modelHash', $self->selectedExitTag->destRoom);
# Select the destination room
$self->setSelectedObj(
[$roomObj, 'room'],
FALSE, # Select this object; unselect all other objects
);
# Centre the map over the selected room, changing the currently displayed region and level
# as necessary
$self->centreMapOverRoom($roomObj);
return 1;
}
sub editExitTagCallback {
# Called by $self->enableLabelsColumn
# Prompts the user to enter a new ->exitTag for the selected exit
#
# 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 ($exitObj, $text);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->editExitTagCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (
(! $self->selectedExit || ! $self->selectedExit->regionFlag)
&& ! $self->selectedExitTag
)
) {
return undef;
}
# Set the exit to use
if ($self->selectedExit) {
$exitObj = $self->selectedExit;
} else {
$exitObj = $self->selectedExitTag;
}
# Prompt the user for the new contents of the exit tag
$text = $self->showEntryDialogue(
'Edit exit tag',
'Enter the new contents of the exit tag (leave empty to reset)',
40, # Max chars
$exitObj->exitTag,
);
if (defined $text) {
# Change the exit tag's contents
$self->worldModelObj->applyExitTag(
TRUE, # Update Automapper windows
$exitObj,
undef, # Parent regionmap not known
$text, # Can be an empty string
TRUE, # Calling function is this string
);
}
return 1;
}
sub resetExitOffsetsCallback {
# Called by $self->enableExitsColumn
# Resets the positions of exit tags by setting their offset IVs to zero
#
# 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 (
@exitList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->resetExitOffsetsCallback',
@_,
);
}
# Standard callback check
if (
! $self->currentRegionmap
|| (
! $self->selectedExit && $self->selectedExitHash
&& ! $self->selectedExitTag && ! $self->selectedExitTagHash
)
) {
return undef;
}
# Compile a list of exits which are selected exits, or which have selected exit tags. Use a
# hash to eliminate duplicates
if ($self->selectedExit) {
$exitHash{$self->selectedExit->number} = $self->selectedExit;
} elsif ($self->selectedExitHash) {
%exitHash = $self->selectedExitHash;
}
if ($self->selectedExitTag) {
$exitHash{$self->selectedExitTag->number} = $self->selectedExitTag;
} elsif ($self->selectedExitTagHash) {
foreach my $key ($self->ivKeys('selectedExitTagHash')) {
$exitHash{$key} = $self->ivShow('selectedExitTagHash', $key);
}
}
# For each exit which has an exit tag, reset its position
@exitList = values %exitHash;
foreach my $exitObj (@exitList) {
if ($exitObj->exitTag) {
$self->worldModelObj->resetExitTag(
TRUE, # Update Automapper windows now
$exitObj,
);
}
}
return 1;
}
sub applyExitTagsCallback {
# Called by $self->enableExitsColumn
# Applies (or cancels) exit tags on all region exits in the current region
#
# Expected arguments
# $applyFlag - If set to TRUE, exit tags are applied. If set to FALSE, exit tags are
# cancelled
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $applyFlag, $check) = @_;
# Local variables
my (@exitNumList, @exitObjList, @drawList);
# Check for improper arguments
if (! defined $applyFlag || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->applyExitTagsCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Import a list of region exits
@exitNumList = $self->currentRegionmap->ivKeys('regionExitHash');
foreach my $exitNum (@exitNumList) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
push (@exitObjList, $exitObj);
push (@drawList, 'exit', $exitObj);
}
# Apply or cancel exit tags for each exit in turn
foreach my $exitObj (@exitObjList) {
if ($applyFlag) {
$self->worldModelObj->applyExitTag(
TRUE, # Update Automapper windows now
$exitObj,
);
} else {
$self->worldModelObj->cancelExitTag(
TRUE, # Update Automapper windows now
$exitObj,
);
}
}
# Redraw the exits immediately
$self->worldModelObj->updateMaps(@drawList);
return 1;
}
sub identifyExitsCallback {
# Called by $self->enableExitsColumn
# Lists all the selected exits in a 'dialogue' window (if more than 10 are selected, we only
# list the first 10)
#
# 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 (
$limit, $msg,
@sortedList, @reducedList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->identifyExitsCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedExit && ! $self->selectedExitHash)) {
return undef;
}
# Compile a list of selected exits and sort by exit model number
@sortedList = sort {$a->number <=> $b->number} ($self->compileSelectedExits());
# Reduce the size of the list to a maximum of $limit
$limit = 10;
if (@sortedList > $limit) {
@reducedList = @sortedList[0..($limit - 1)];
} else {
@reducedList = @sortedList;
}
# Prepare the message to show in the 'dialogue' window
if (scalar @sortedList != scalar @reducedList) {
$msg = "Selected exits (first " . $limit . " exits of " . scalar @sortedList . ")\n";
} elsif (scalar @sortedList == 1) {
$msg = "Selected exits (1 exit)\n";
} else {
$msg = "Selected exits (" . scalar @sortedList . " exits)\n";
}
foreach my $exitObj (@reducedList) {
my $customDir;
# Convert the exit's map direction, ->mapDir (a standard primary direction) into a
# custom primary direction, so that we can compare it with the exit's nominal
# direction
$customDir = $self->session->currentDict->ivShow('primaryDirHash', $exitObj->mapDir);
if (! $customDir || $customDir eq $exitObj->dir) {
$msg .= " #" . $exitObj->number . " '" . $exitObj->dir . "' (room #"
. $exitObj->parent . ")\n";
} else {
$msg .= " #" . $exitObj->number . " '" . $exitObj->dir . "' [" . $exitObj->mapDir
. "] (room #" . $exitObj->parent . ")\n";
}
}
# Display a popup to show the results
$self->showMsgDialogue(
'Identify exits',
'info',
$msg,
'ok',
undef,
TRUE, # Preserve newline characters in $msg
);
return 1;
}
sub editExitCallback {
# Called by $self->enableExitsColumn
# Opens a GA::EditWin::Exit for the selected exit. If the selected exit could be confused
# with others occupying (roughly) the same space, opens a 'dialogue' window so the user
# can choose one
#
# 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 (
$comboListRef, $exitHashRef, $choice, $exitObj,
@comboList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->editExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# If the selected exit has a twin exit and/or a shadow exit, we need to prompt the user to
# ask which of them should be edited
if ($self->selectedExit->twinExit || $self->selectedExit->shadowExit) {
($comboListRef, $exitHashRef) = $self->compileExitList();
if (! defined $comboListRef) {
return undef;
}
@comboList = @$comboListRef;
%exitHash = %$exitHashRef;
# Prompt the user to choose which exit to edit
$choice = $self->showComboDialogue(
'Select exit',
'Select which exit to edit:',
\@comboList,
);
if (! $choice) {
return undef;
} else {
$exitObj = $exitHash{$choice};
# Also make this the selected exit
$self->setSelectedObj(
[$exitHash{$choice}, 'exit'],
FALSE, # Select this object; unselect all other objects
);
}
# Otherwise, just edit the selected exit
} else {
$exitObj = $self->selectedExit;
}
# Open up an 'edit' window to edit the object
$self->createFreeWin(
'Games::Axmud::EditWin::Exit',
$self,
$self->session,
'Edit exit model object #' . $exitObj->number,
$exitObj,
FALSE, # Not temporary
);
return 1;
}
sub completeExitsCallback {
# Called by $self->enableExitsColumn
# Checks all of the selected exits and exits of selected rooms
# Converts any uncertain exits into two-way exits
#
# 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 (
@exitNumList, @exitObjList, @roomObjList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->completeExitsCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Compile a list of all selected rooms in the current regionmap
@roomObjList = $self->compileSelectedRooms();
# Compile a hash of all selected exits in the current regionmap
foreach my $exitObj ($self->compileSelectedExits()) {
$exitHash{$exitObj->number} = $exitObj;
}
# Go through the list of rooms, adding all its exits to a hash (to eliminate duplicates)
foreach my $roomObj (@roomObjList) {
if ($roomObj->exitNumHash) {
@exitNumList = $roomObj->ivValues('exitNumHash');
foreach my $exitNum (@exitNumList) {
if (! exists $exitHash{$exitNum}) {
$exitHash{$exitNum}
= $self->worldModelObj->ivShow('exitModelHash', $exitNum);
}
}
}
}
# Extract the hash into a list of exit objects, comprising all the selected exits and
# all exits belonging to selected rooms
@exitObjList = values %exitHash;
# Check each exit in turn. If it's an uncertain exit and if, in the opposite direction,
# there's an incomplete exit, convert the pair into two-way exits. Instruct the world
# model to update its Automapper windows
$self->worldModelObj->completeExits(
$self->session,
TRUE, # Update Automapper windows now
@exitObjList,
);
return 1;
}
sub connectAdjacentCallback {
# Called by $self->enableExitsColumn
# Connects any selected rooms which are adjacent to each other, and have incomplete/
# uncertain exits which can be converted into twin exits between them
#
# 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 (
$wmObj, $horizontalLength, $verticalLength,
@roomObjList, @redrawList,
%roomHash, %exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->connectAdjacentCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedRoom && ! $self->selectedRoomHash)) {
return undef;
}
# Import the world model (for convenience)
$wmObj = $self->worldModelObj;
# Also import the standard exit lengths (for convenience)
$horizontalLength = $wmObj->horizontalExitLengthBlocks;
$verticalLength = $wmObj->verticalExitLengthBlocks;
# Compile a list of all selected rooms in the current regionmap
@roomObjList = $self->compileSelectedRooms();
# Also compile a hash (for quick lookup)
foreach my $roomObj (@roomObjList) {
$roomHash{$roomObj->number} = undef;
}
# Go through each room in turn, checking its incomplete and uncertain exits. For both, if
# there's an adjacent room with an exit in the opposite direction, convert them into
# twin exits
# If GA::Obj::WorldModel->horizontalExitLengthBlocks is set to 1, then an adjacent room is
# in the next gridblock. If it is set to 2, an adjacent room is two gridblocks away. (The
# same applies for ->verticalExitLengthBlocks)
# If either value is set to 2 or more, there must be no rooms between the two 'adjacent'
# rooms
OUTER: foreach my $roomObj (@roomObjList) {
my $regionmapObj = $self->findRegionmap($roomObj->parent);
INNER: foreach my $exitDir ($roomObj->ivKeys('exitNumHash')) {
my (
$exitNum, $exitObj, $vectorRef, $exitLength, $xPosBlocks, $yPosBlocks,
$zPosBlocks, $adjacentNum, $adjacentRoomObj, $result, $oppDir, $oppExitObj,
);
$exitNum = $roomObj->ivShow('exitNumHash', $exitDir);
$exitObj = $wmObj->ivShow('exitModelHash', $exitNum);
# Discard everything besides incomplete and uncertain exits which haven't been
# processed yet
# Also discard retracting, random and unallocated exits
if (
exists $exitHash{$exitNum}
|| $exitObj->retraceFlag
|| $exitObj->randomType ne 'none'
|| $exitObj->drawMode eq 'temp_alloc'
|| $exitObj->drawMode eq 'temp_unalloc'
) {
next INNER;
}
if (! $exitObj->destRoom && $exitObj->randomType eq 'none') {
# Incomplete exit. Is there an adjacent room, with no rooms in between $roomObj
# and the adjacent room?
# Work out the potential adjacent room's location on the grid
$vectorRef = $self->ivShow('constVectorHash', $exitObj->mapDir);
if ($exitObj->mapDir eq 'up' || $exitObj->mapDir eq 'down') {
$exitLength = $verticalLength;
} else {
$exitLength = $horizontalLength;
}
$xPosBlocks = $roomObj->xPosBlocks + ($$vectorRef[0] * $exitLength);
$yPosBlocks = $roomObj->yPosBlocks + ($$vectorRef[1] * $exitLength);
$zPosBlocks = $roomObj->zPosBlocks + ($$vectorRef[2] * $exitLength);
# See if there is a potential adjacent room at this location that is a selected
# room
$adjacentNum = $regionmapObj->fetchRoom($xPosBlocks, $yPosBlocks, $zPosBlocks);
if (! $adjacentNum || ! exists $roomHash{$adjacentNum}) {
next INNER;
}
$adjacentRoomObj = $wmObj->ivShow('modelHash', $adjacentNum);
# If $exitLength is greater than 1, make sure there are no rooms in between
# $roomObj and the adjacent room
if ($exitLength > 1) {
# We can borrow GA::Obj::WorldModel->checkRoomAlignment to perform this
# check for us. Temporarily set the exit's destination room as the
# adjacent room to make it work
$exitObj->ivPoke('destRoom', $adjacentNum);
$result = $wmObj->checkRoomAlignment($self->session, $exitObj);
$exitObj->ivUndef('destRoom');
if (! $result) {
next INNER;
}
}
# Finally, check that the adjacent room has a suitable exit in the opposite
# direction to $exitObj
$oppDir = $axmud::CLIENT->ivShow('constOppDirHash', $exitObj->mapDir);
THISLOOP: foreach my $otherExitDir ($adjacentRoomObj->ivKeys('exitNumHash')) {
my ($otherExitNum, $otherExitObj);
$otherExitNum = $adjacentRoomObj->ivShow('exitNumHash', $otherExitDir);
$otherExitObj = $wmObj->ivShow('exitModelHash', $otherExitNum);
if (
! exists $exitHash{$otherExitNum}
&& ! $otherExitObj->destRoom
&& ! $otherExitObj->retraceFlag
&& $otherExitObj->randomType eq 'none'
&& (
$otherExitObj->drawMode eq 'primary'
|| $otherExitObj->drawMode eq 'perm_alloc'
)
&& $otherExitObj->mapDir eq $oppDir
) {
# This exit is suitable, and in the right direction
$oppExitObj = $otherExitObj;
last THISLOOP;
}
}
if ($oppExitObj) {
# Connect these two adjacent rooms, converting $exitObj into an uncertain
# exit
$self->worldModelObj->connectRooms(
$self->session,
FALSE, # Don't update Automapper windows yet
$roomObj,
$adjacentRoomObj,
$exitObj->dir,
$exitObj->mapDir,
$exitObj,
);
# Only process each pair of exits once
$exitHash{$exitObj->number} = $exitObj;
$exitHash{$oppExitObj->number} = $oppExitObj;
}
} elsif (
$exitObj->destRoom
&& ((! $exitObj->twinExit) && (! $exitObj->oneWayFlag))
) {
# Uncertain exit. Code below converts it into a two-way exit; but we mustn't
# convert it if the destination room wasn't one of the selected rooms
if (exists $roomHash{$exitObj->destRoom}) {
$exitHash{$exitObj->number} = $exitObj;
}
}
}
}
# Check each connected exit in turn. If it's an uncertain exit, convert it and its twin
# into a two-way exit
$self->worldModelObj->completeExits(
$self->session,
FALSE, # Don't update Automapper windows yet
values %exitHash,
);
# NOW we can update Automapper windows, using each selected room (this is hopefully faster
# than letting ->completeExits do it for every affected exit)
foreach my $roomObj (@roomObjList) {
push (@redrawList, 'room', $roomObj);
}
$self->worldModelObj->updateMaps(@redrawList);
return 1;
}
sub setExitLengthCallback {
# Called by $self->enableExitsColumn
# Prompts the user for a new exit length (distance between adjacent rooms on the map, when
# they are added), and sets GA::Obj::WorldModel->horizontalExitLengthBlocks or
# ->verticalExitLengthBlocks accordingly
#
# Expected arguments
# $type - 'horizontal' or 'vertical', corresponding to the exit length IV stored in the
# world model to be set
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my ($range, $title, $msg, $length);
# Check for improper arguments
if (! defined $type || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setExitLengthCallback', @_);
}
# (No standard callback checks for this function)
# Prompt the user for a new exit length
$range = '(1-' . $self->worldModelObj->maxExitLengthBlocks . ', currently set to ';
if ($type eq 'vertical') {
$title = 'Set vertical exit length';
$msg = 'Set the distance between stacked rooms ' . $range
. $self->worldModelObj->verticalExitLengthBlocks . ')';
} else {
# (In case $type was not set to 'horizontal' or 'vertical', just carry on as if it were
# 'horizontal')
$type = 'horizontal';
$title = 'Set horizontal exit length';
$msg = 'Set the distance between adjacent rooms ' . $range
. $self->worldModelObj->horizontalExitLengthBlocks . ')';
}
$length = $self->showEntryDialogue(
$title,
$msg,
);
if ($length) {
# Check that $length is a valid integer, in the permitted range
if (
! ($length =~ /\D/)
&& $length > 0
&& $length <= $self->worldModelObj->maxExitLengthBlocks
) {
$self->worldModelObj->set_exitLengthBlocks($type, $length);
} else {
# Show an explanatory message
$self->showMsgDialogue(
$title,
'error',
'Invalid value for exit length - must be an integer between 1 and '
. $self->worldModelObj->maxExitLengthBlocks,
'ok',
);
}
}
return 1;
}
sub resetExitLengthCallback {
# Called by $self->enableExitsColumn
# Resets the horizontal and vertical exit lengths stored in the world model back to the
# default value of 1
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->resetExitLengthCallback',
@_,
);
}
# (No standard callback checks for this function)
# If both exit lengths are already set to 1, there's nothing to do
if (
$self->worldModelObj->horizontalExitLengthBlocks == 1
&& $self->worldModelObj->verticalExitLengthBlocks == 1
) {
$self->showMsgDialogue(
'Reset exit length',
'warning',
'Both types of exit length were already set to 1',
'ok',
);
} else {
# Reset the exit lengths and display a confirmation
$self->worldModelObj->set_exitLengthBlocks('horizontal', 1);
$self->worldModelObj->set_exitLengthBlocks('vertical', 1);
$self->showMsgDialogue(
'Reset exit length',
'info',
'Both types of exit length were reset to 1',
'ok',
);
}
return 1;
}
sub deleteExitCallback {
# Called by $self->enableExitsColumn
# Deletes the currently selected exit. If the selected exit could be confused with others
# occupying (roughly) the same space, opens a 'dialogue' window so the user can choose one
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if there's an
# error
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$bothString, $allString, $stringListRef, $exitHashRef, $choice,
@stringList, @comboList, @finalList,
%exitHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->deleteExitCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedExit) {
return undef;
}
# Possible initial combo items
$bothString = '<delete both>';
$allString = '<delete all>';
# Compile a list of exits which could be confused with the currently selected one
($stringListRef, $exitHashRef) = $self->compileExitList();
if (! defined $stringListRef) {
return undef;
}
@stringList = @$stringListRef;
%exitHash = %$exitHashRef;
# If there is more than one exit in the list, prompt the user to specify which one to delete
if (scalar @stringList > 1) {
# Compile the combo list
if (@stringList == 2) {
@comboList = ($bothString, @stringList);
} elsif (@stringList > 2) {
@comboList = ($allString, @stringList);
} else {
@comboList = @stringList;
}
# Prompt the user to choose which exit to delete
$choice = $self->showComboDialogue(
'Select exit',
'Select which exit to delete',
\@comboList,
);
if (! $choice) {
return undef;
} elsif ($choice eq $bothString || $choice eq $allString) {
@finalList = values %exitHash;
} else {
push (@finalList, $exitHash{$choice});
}
} else {
# There's only one exit on which to operate
push (@finalList, $self->selectedExit);
}
# Delete the exit object(s) and instruct the world model to update its Automapper windows
$self->worldModelObj->deleteExits(
$self->session,
TRUE, # Update Automapper windows now
@finalList,
);
return 1;
}
sub addBendCallback {
# Called by $self->enableExitsPopupMenu (only)
# After a right-click on an exit, when the user has selected 'add bend' in the popup menu,
# add a bend at the same position
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the bend is
# not added
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$startXPos, $startYPos, $clickXPos, $clickYPos, $stopXPos, $stopYPos, $resultType,
$twinExitObj,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->addBendCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| (! $self->selectedExit->oneWayFlag && ! $self->selectedExit->twinExit)
|| $self->selectedExit->regionFlag
|| ! defined $self->exitClickXPosn
|| ! defined $self->exitClickYPosn
) {
return undef;
}
# Get the absolute coordinates of the start of the middle (bending) section of the
# exit
# At the same time, convert the absolute coordinates of the right-mouse click on the exit,
# and the absolute coordinates of the end of the bending section, into coordinates
# relative to the start of the bending section of the eixt
($startXPos, $startYPos, $clickXPos, $clickYPos, $stopXPos, $stopYPos, $resultType)
= $self->findExitClick(
$self->selectedExit,
$self->exitClickXPosn,
$self->exitClickYPosn,
);
# If the click wasn't in the parent room's gridblock, in the destination room's gridblock
# or too close to an existing bend...
if (! $resultType) {
# Add a bend to the exit
$self->worldModelObj->addExitBend(
FALSE, # Don't update Automapper windows yet
$self->selectedExit,
$startXPos, $startYPos,
$clickXPos, $clickYPos,
$stopXPos, $stopYPos,
);
# Repeat the process for the selected exit's twin (if there is one)
if ($self->selectedExit->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow(
'exitModelHash',
$self->selectedExit->twinExit,
);
($startXPos, $startYPos, $clickXPos, $clickYPos, $stopXPos, $stopYPos)
= $self->findExitClick(
$twinExitObj,
$self->exitClickXPosn,
$self->exitClickYPosn,
);
$self->worldModelObj->addExitBend(
FALSE, # Don't update Automapper windows yet
$twinExitObj,
$startXPos, $startYPos,
$clickXPos, $clickYPos,
$stopXPos, $stopYPos,
);
}
# Now we can redraw the exit
$self->worldModelObj->updateMapExit(
$self->selectedExit,
$twinExitObj, # May be 'undef'
);
return 1;
} else {
# If the click was too close to an existing bend, show a message explaining why nothing
# has happened (don't bother showing a message for other values of $resultType, which
# probably can't be returned to this function anyway)
if ($resultType eq 'near_bend') {
$self->showMsgDialogue(
'Add bend',
'error',
'Cannot add a bend - you clicked too close to an existing bend',
'ok',
);
}
return undef;
}
}
sub removeBendCallback {
# Called by $self->enableExitsPopupMenu (only)
# After a right-click on an exit, when the user has selected 'remove bend' in the popup
# menu, remove the bend closest to the clicked position
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails or if the mouse
# click was not near a bend
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($index, $twinExitObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->removeBendCallback', @_);
}
# Standard callback check
if (
! $self->currentRegionmap
|| ! $self->selectedExit
|| (! $self->selectedExit->oneWayFlag && ! $self->selectedExit->twinExit)
|| ! $self->selectedExit->bendOffsetList
|| ! defined $self->exitClickXPosn
|| ! defined $self->exitClickYPosn
) {
return undef;
}
# Find the number of the bend which is closest to the the clicked position
$index = $self->findExitBend(
$self->selectedExit,
$self->exitClickXPosn,
$self->exitClickYPosn,
);
if (! defined $index) {
$self->showMsgDialogue(
'Remove bend',
'error',
'Please right-click on the bend that you want to remove',
'ok',
);
return undef;
} else {
# Remove this bend
$self->worldModelObj->removeExitBend(
$self->session,
TRUE, # Update Automapper windows now
$self->selectedExit,
$index, # Remove this bend (first bend is numbered 0)
);
# If there is a twin exit, remove the corresponding bend at the same time
if ($self->selectedExit->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow(
'exitModelHash',
$self->selectedExit->twinExit,
);
$self->worldModelObj->removeExitBend(
$self->session,
TRUE, # Update Automapper windows now
$twinExitObj,
((scalar $self->selectedExit->bendOffsetList / 2) - $index - 1),
);
}
return 1;
}
}
# Menu 'Labels' column callbacks
sub addLabelAtBlockCallback {
# Called by $self->enableLabelsColumn
# Prompts the user to supply a gridblock (via a 'dialogue' window) and creates a label at
# that location
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user clicks
# the 'cancel' button on the 'dialogue' window or if the new label can't be created
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($xPosBlocks, $yPosBlocks, $zPosBlocks, $text, $style);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addLabelAtBlockCallback',
@_,
);
}
# Standard callback check
if (! $self->currentRegionmap) {
return undef;
}
# Prompt the user for a gridblock
($xPosBlocks, $yPosBlocks, $zPosBlocks) = $self->promptGridBlock();
if (! defined $xPosBlocks) {
# User clicked the 'cancel' button
return undef;
}
# Check that the specified gridblock actually exists
if (
! $self->currentRegionmap->checkGridBlock(
$xPosBlocks,
$yPosBlocks,
$zPosBlocks,
)
) {
$self->showMsgDialogue(
'Add label at block',
'error',
'Invalid gridblock: x=' . $xPosBlocks . ', y=' . $yPosBlocks . ', z=' . $zPosBlocks,
'ok',
);
}
# Prompt the user to specify the label text
($text, $style) = $self->promptConfigLabel();
# Free click mode must be reset (nothing special happens when the user clicks on the map)
$self->reset_freeClickMode();
if (defined $text && $text =~ m/\S/) {
# Create a new label at the specified location
$self->worldModelObj->addLabel(
$self->session,
TRUE, # Update Automapper windows now
$self->currentRegionmap,
($xPosBlocks * $self->currentRegionmap->blockWidthPixels),
($yPosBlocks * $self->currentRegionmap->blockHeightPixels),
$zPosBlocks,
$text,
$style,
);
# The specified style is the preferred one
if (defined $style) {
$self->worldModelObj->set_mapLabelStyle($style);
}
return 1;
} else {
return undef;
}
}
sub addLabelAtClickCallback {
# Called by $self->enableCanvasPopupMenu and ->canvasEventHandler
# Adds a label at a specified location on the current level
#
# Expected arguments
# $xPosPixels, $yPosPixels
# - The grid coordinates at which to create the label
#
# Return values
# 'undef' on improper arguments, if the user clicks the 'cancel' button on the 'dialogue'
# window or if the new label can't be created
# 1 otherwise
my ($self, $xPosPixels, $yPosPixels, $check) = @_;
# Local variables
my ($text, $style);
# Check for improper arguments
if (! defined $xPosPixels || ! defined $yPosPixels || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->addLabelAtClickCallback',
@_,
);
}
# (No standard callback checks for this function)
# Prompt the user to specify the label text
($text, $style) = $self->promptConfigLabel();
# Free click mode must be reset (nothing special happens when the user clicks on the map)
$self->reset_freeClickMode();
if ($text || (defined $text && $text eq '0')) { # '0' is a valid label
# Create a new label at the specified location
$self->worldModelObj->addLabel(
$self->session,
TRUE, # Update Automapper windows now
$self->currentRegionmap,
$xPosPixels,
$yPosPixels,
$self->currentRegionmap->currentLevel,
$text,
$style,
);
# The specified style is the preferred one
if (defined $style) {
$self->worldModelObj->set_mapLabelStyle($style);
}
return 1;
} else {
return undef;
}
}
sub setLabelCallback {
# Called by $self->enableLabelsColumn
# Prompts the user to modify a label's text and style (presenting only a list of map label
# style objects to choose from), using the same 'dialogue' window used to add a label
#
# Expected arguments
# $customiseFlag - If FALSE, the 'dialogue' window only shows label text and style. If
# TRUE, the 'dialogue' window shows all label IVs
#
# Return values
# 'undef' on improper arguments or if the standard callback check fails
# 1 otherwise
my ($self, $customiseFlag, $check) = @_;
# Local variables
my ($text, $style);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setLabelCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || ! $self->selectedLabel) {
return undef;
}
# Prompt the user to mod the label
($text, $style) = $self->promptConfigLabel($self->selectedLabel, $customiseFlag);
if (defined $text && $text =~ m/\S/) {
$self->worldModelObj->updateLabel(
TRUE, # Update automapper windows now
$self->session,
$self->selectedLabel,
$text,
$style,
);
# 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
);
}
}
return 1;
}
sub addStyleCallback {
# Called by $self->enableLabelsColumn
# Prompts the user for a name, then creates a label style with that name
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the user doesn't complete the prompt
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($name, $styleObj);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->selectLabelCallback', @_);
}
# (No standard callback check)
# Prompt the user for a name
$name = $self->showEntryDialogue(
'Add label style',
'Enter a name for a new label style (max 16 characters including spaces)',
);
if (! defined $name) {
return undef;
}
# Check that the style doesn't already exist
if ($self->worldModelObj->ivExists('mapLabelStyle', $name)) {
return $self->showMsgDialogue(
'Add label style',
'error',
'A label style called \'' . $name . '\' already exists',
'ok',
);
}
# Add the style
if (
! $self->session->pseudoCmd(
'addlabelstyle <' . $name . '>',
'win_error',
),
) {
return undef;
}
$styleObj = $self->worldModelObj->ivShow('mapLabelStyleHash', $name);
if ($styleObj) {
# Open an 'edit' window for the new label style
$self->createFreeWin(
'Games::Axmud::EditWin::MapLabelStyle',
$self,
$self->session,
'Edit map label style \'' . $styleObj->name . '\'',
$styleObj,
FALSE, # Not temporary
);
}
return 1;
}
sub editStyleCallback {
# Called by $self->enableLabelsColumn
# Prompts the user for a label style and then opens an 'edit' window for the style
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the user doesn't complete the prompt
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$choice, $styleObj,
@comboList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->editStyleCallback', @_);
}
# (No standard callback check)
# Get a list of styles
@comboList = sort {lc($a) cmp lc($b)} ($self->worldModelObj->ivKeys('mapLabelStyleHash'));
# Prompt the user
$choice = $self->showComboDialogue(
'Edit label style',
'Select which label style to edit',
\@comboList,
);
if (! defined $choice) {
return undef;
}
$styleObj = $self->worldModelObj->ivShow('mapLabelStyleHash', $choice);
if ($styleObj) {
# Open an 'edit' window for the new label style
$self->createFreeWin(
'Games::Axmud::EditWin::MapLabelStyle',
$self,
$self->session,
'Edit map label style \'' . $styleObj->name . '\'',
$styleObj,
FALSE, # Not temporary
);
}
}
sub toggleAlignCallback {
# Called by $self->enableLabelsColumn
# Prompts the user for confirmation before toggling horizontal/vertical label alignment
#
# Expected arguments
# $type - Which type of alignment to toggle - 'horizontal' or 'vertical'
#
# Return values
# 'undef' on improper arguments or if the user doesn't complete the prompt
# 1 otherwise
my ($self, $type, $check) = @_;
# Local variables
my ($msg, $choice);
# Check for improper arguments
if (! defined $type || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->toggleAlignCallback', @_);
}
# (No standard callback check)
# Prompt the user for confirmation
if (
($type eq 'horizontal' && ! $self->worldModelObj->mapLabelAlignXFlag)
|| ($type eq 'vertical' && ! $self->worldModelObj->mapLabelAlignYFlag)
) {
$msg = 'Are you sure you want to enable ' . $type . ' label alignment?';
} else {
$msg = 'Are you sure you want to disable ' . $type . ' label alignment?';
}
$choice = $self->showMsgDialogue(
'Toggle label alignment',
'question',
$msg,
'yes-no',
);
if (! defined $choice || $choice eq 'no') {
return undef;
} else {
$self->worldModelObj->toggleLabelAlignment(
$self->session,
TRUE, # Update automapper windows now
$type,
);
}
}
sub deleteLabelsCallback {
# Called by $self->enableLabelsColumn (only)
# If multiple labels are selected, prompts the user before deleting them (there is no
# confirmation prompt if a single label is selected)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the standard callback check fails, if the user
# changes their mind or if the deletion operation fails
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $result;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->deleteLabelsCallback', @_);
}
# Standard callback check
if (! $self->currentRegionmap || (! $self->selectedLabel && ! $self->selectedLabelHash)) {
return undef;
}
# Prompt the user for confirmation before deleting multiple labels
if ($self->selectedLabelHash) {
$result = $self->showMsgDialogue(
'Delete labels',
'question',
'Are you sure you want to delete ' . $self->ivPairs('selectedLabelHash')
. ' labels?',
'yes-no',
);
if ($result ne 'yes') {
return undef;
}
}
# Delete the selected label(s)
return $self->worldModelObj->deleteLabels(
TRUE, # Update Automapper windows now
$self->compileSelectedLabels(),
);
}
# IV setting functions
sub setMode {
# Can be called by anything
# Sets the automapper's operating mode and updates other IVs/widgets
# NB If the Locator isn't running, a call to this function always sets the mode to 'wait'
#
# Expected arguments
# $mode - The new mode:
# 'wait' - The automapper isn't doing anything
# 'follow' - The automapper is following the character's position, but not
# updating the world model
# 'update' - The automapper is updating the world model as the character
# moves around
#
# Return values
# 'undef' on improper arguments, or if an attempt to switch to 'update' mode fails because
# the Locator task is expecting room descriptions
# 1 otherwise
my ($self, $mode, $check) = @_;
# Local variables
my (
$taskObj, $title, $oldMode, $menuItemName, $radioMenuItem, $toolbarButtonName,
$toolbarButton,
);
# Check for improper arguments
if (
! defined $mode || ($mode ne 'wait' && $mode ne 'follow' && $mode ne 'update')
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setMode', @_);
}
# Import the current session's Locator task
$taskObj = $self->session->locatorTask;
# If the Locator isn't running or if there is no current regionmap, the mode must be set to
# 'wait'
if (! $taskObj || ! $self->currentRegionmap) {
$mode = 'wait';
} elsif ($self->mode eq 'update' && $self->worldModelObj->disableUpdateModeFlag) {
# This function is called just after GA::Obj::WorldModel->toggleDisableUpdateModeFlag
# has set ->disableUpdateModeFlag to TRUE. Now that update mode has been disabled,
# switch to 'follow' mode
$mode = 'follow';
} elsif (
($self->mode ne 'update' && $mode eq 'update')
|| ($self->mode eq 'wait' && $mode eq 'follow')
) {
# Don't switch to update mode if it is disabled, or if the session is in 'connect
# offline' mode
if (
$mode eq 'update'
&& (
$self->worldModelObj->disableUpdateModeFlag
|| $self->session->status eq 'offline'
)
) {
# Retain the current mode ('wait' or 'follow')
$mode = $self->mode;
# If we're trying to switch from 'wait' to 'follow' mode, or from 'wait/'follow' to
# 'update' mode, the Locator task must not be expecting room descriptions (doing this
# prevents the map from adding rooms based on junk data, or from getting lost
# immediately because it expected the wrong room)
# If the Locator is expecting descriptions, refuse to switch mode
} elsif ($taskObj->moveList) {
if ($taskObj->moveList == 1) {
$title = 'Set mode (1 missing room statement)';
} else {
$title = 'Set mode (' . scalar $taskObj->moveList . ' missing room statements)';
}
$self->showMsgDialogue(
$title,
'warning',
'The automapper can\'t switch to \'' . $mode . '\' mode until the Locator task'
. ' is no longer expecting any rooms (try: Rooms - Locator task - Reset'
. ' Locator)',
'ok',
);
# Retain the current mode ('wait' or 'follow')
$mode = $self->mode;
}
}
# We need to compare the old/new settings of $self->mode in a moment
$oldMode = $self->mode;
# Set the automapper's new operating mode
$self->ivPoke('mode', $mode);
# Even if $self->mode hasn't changed, it might not match the menu items and the toolbar
# button; so we must make sure the right ones are activated. Use
# $self->ignoreMenuUpdateFlag so that toggling a menu item doesn't toggle a toolbar icon
# (and vice-versa)
$self->ivPoke('ignoreMenuUpdateFlag', TRUE);
# Update radio buttons in the menu (if the menu is visible)
$menuItemName = 'set_'. $mode . '_mode';
if ($self->menuBar && $self->ivExists('menuToolItemHash', $menuItemName)) {
$radioMenuItem = $self->ivShow('menuToolItemHash', $menuItemName);
$radioMenuItem->set_active(TRUE);
}
# Update toolbar buttons in the toolbar (if the toolbar is visible)
$toolbarButtonName = 'icon_set_'. $mode . '_mode';
if ($self->toolbarList && $self->ivExists('menuToolItemHash', $toolbarButtonName)) {
$toolbarButton = $self->ivShow('menuToolItemHash', $toolbarButtonName);
$toolbarButton->set_active(TRUE);
}
# Make sure that the radio/toolbar buttons for 'update mode' are sensitive, or not
$self->restrictUpdateMode();
$self->ivPoke('ignoreMenuUpdateFlag', FALSE);
# In case the automapper object's ghost room gets set to the wrong room, switching to
# 'wait' mode temporarily must reset it
if ($self->mode eq 'wait' && $self->mapObj->ghostRoom) {
$self->mapObj->setGhostRoom(); # Automatically redraws the room
# If switching from 'wait' to 'follow'/'update' mode and there is a current room set, the
# ghost room will not be set, so st it
} elsif (
$oldMode eq 'wait'
&& $self->mode ne 'wait'
&& $self->mapObj->currentRoom
&& ! $self->mapObj->ghostRoom
) {
$self->mapObj->setGhostRoom($self->mapObj->currentRoom);
}
if ($self->mapObj->currentRoom) {
# Redraw the current room in its correct colour (default pink in 'wait' mode, default
# red in 'follow'/'update' mode)
$self->markObjs('room', $self->mapObj->currentRoom);
$self->doDraw();
}
return 1;
}
sub setCurrentRegion {
# Called by $self->treeViewRowActivated and $self->newRegionCallback. Also called by
# GA::Obj::Map->setCurrentRoom
# Sets the new current region and draws its map (if not already drawn)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $name - The name of the region (matches a key in
# GA::Obj::WorldModel->regionmapHash). If set to 'undef', there is no
# current region (and an empty map must be displayed)
# $forceFlag - Set to TRUE when called by GA::Obj::Map->setCurrentRoom. Changes the
# $name region's current level to show the current room, if there is one
# (otherwise, the current level is only changed when the automapper is in
# 'follow' or 'update' mode)
#
# Return values
# 'undef' on improper arguments or if a specified region $name doesn't match a known
# regionmap
# 1 otherwise
my ($self, $name, $forceFlag, $check) = @_;
# Local variables
my (
$scrollXPos, $scrollYPos, $oldRegionmapObj, $oldParchmentObj, $count, $destroyFlag,
$index, $regionmapObj, $destroyObj, $parchmentObj, $currentRoom,
@newList,
%occupyHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setCurrentRegion', @_);
}
# If the tooltips are visible, hide them
$self->hideTooltips();
# If there's already a visible map...
if ($self->currentRegionmap) {
# Remember the current position of the scrollbars so that, the next time this region is
# opened, it can be shown in the same position (and at the same magnification)
($scrollXPos, $scrollYPos) = $self->getMapPosn();
$self->currentRegionmap->ivPoke('scrollXPos', $scrollXPos);
$self->currentRegionmap->ivPoke('scrollYPos', $scrollYPos);
# Count the number of rooms in the region, so we can decide whether to retain the
# parchment object in memory
$oldRegionmapObj = $self->currentRegionmap;
$oldParchmentObj = $self->currentParchment;
$count = $self->currentRegionmap->ivPairs('gridRoomHash');
# If this region contains fewer rooms than the minimum (or if the region has just been
# deleted), then its parchment object will not be retained in memory
# If the region has no rooms, the map is not retained in memory, regardless of the value
# of GA::Obj::WorldModel->preDrawRetainRooms
if (
(! $count || $count < $self->worldModelObj->preDrawRetainRooms)
&& $self->worldModelObj->ivExists('regionmapHash', $oldRegionmapObj->name)
) {
$destroyFlag = TRUE;
}
}
# If no region was specified...
if (! defined $name) {
# Reset the current region
$self->ivUndef('currentRegionmap');
$self->ivUndef('currentParchment');
$self->ivEmpty('recentRegionList');
# Change the window title back to its default
$self->setWinTitle();
# Redraw the drawing area widget, which will be without a map showing. Also redraw the
# menu bar and title bar, so that the various checkbuttons/radiobuttons are showing
# their neutral positions
$self->redrawWidgets('menu_bar', 'toolbar', 'canvas');
# Set the automapper's mode back to 'wait'
$self->setMode('wait');
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# Destroy any previously-drawn map, if required
if ($destroyFlag) {
$self->ivDelete('parchmentHash', $oldParchmentObj->name);
$self->ivDelete('parchmentReadyHash', $oldParchmentObj->name);
$index = $self->ivFind('parchmentQueueList', $oldParchmentObj);
if (defined $index) {
$self->ivSplice('parchmentQueueList', $index, 1);
# Show the next region to be pre-drawn (if any) in the window's title bar
$self->setWinTitle();
}
}
return 1;
}
# Otherwise, find the regionmap matching the specified region
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $name);
if (! $regionmapObj) {
# Region $name doesn't seem to exist
return undef;
}
# Store the current region (if any) in the list of recent regionmap names
if ($self->currentRegionmap) {
foreach my $otherName ($self->recentRegionList) {
if ($otherName ne $name && $otherName ne $self->currentRegionmap->name) {
push (@newList, $otherName);
}
}
if ($self->currentRegionmap ne $regionmapObj) {
unshift (@newList, $self->currentRegionmap->name);
}
if ((scalar @newList) > 3) {
@newList = splice(@newList, 0, 3);
}
$self->ivPoke('recentRegionList', @newList);
}
# If a parchment object for this regionmap exists, use it
if ($self->ivExists('parchmentHash', $regionmapObj->name)) {
# Set this regionmap as the new current region
$self->ivPoke('currentRegionmap', $regionmapObj);
# Use its existing parchment object
$self->ivPoke('currentParchment', $self->ivShow('parchmentHash', $regionmapObj->name));
# Move the parchment object to top of the queue
$self->ivDelete('parchmentReadyHash', $regionmapObj->name);
$index = $self->ivFind('parchmentQueueList', $self->currentParchment);
if (defined $index) {
$self->ivSplice('parchmentQueueList', $index, 1);
}
$self->ivUnshift('parchmentQueueList', $self->currentParchment);
# At the end of this function, any previously-drawn map should be destroyed, if required
# (otherwise, its parchment object is retained in memory)
if ($destroyFlag && $oldRegionmapObj ne $regionmapObj) {
$destroyObj = $oldParchmentObj;
}
# Otherwise, create a new parchment
} else {
# If the previously-drawn map is marked to be destroyed, then perform the destruction
# operation now
if ($destroyFlag) {
$self->ivDelete('parchmentHash', $oldParchmentObj->name);
$self->ivDelete('parchmentReadyHash', $oldParchmentObj->name);
$index = $self->ivFind('parchmentQueueList', $oldParchmentObj);
if (defined $index) {
$self->ivSplice('parchmentQueueList', $index, 1);
}
}
# Create the new parchment object
$parchmentObj = Games::Axmud::Obj::Parchment->new(
$regionmapObj->name,
$self->worldModelObj,
);
# Update our own IVs
$self->ivAdd('parchmentHash', $parchmentObj->name, $parchmentObj);
$self->ivPoke('currentRegionmap', $regionmapObj);
$self->ivPoke('currentParchment', $parchmentObj);
$self->ivUnshift('parchmentQueueList', $parchmentObj);
# Create a hash of levels in the region that are occupied by rooms and/or labels (exits
# can't exist independently of rooms, so no need to check them)
# At the same time, mark all rooms and labels to be drawn
foreach my $roomNum ($regionmapObj->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
$occupyHash{$roomObj->zPosBlocks} = undef;
$parchmentObj->ivAdd('markedRoomHash', $roomObj->number, $roomObj);
}
foreach my $mapLabelObj ($regionmapObj->ivValues('gridLabelHash')) {
$occupyHash{$mapLabelObj->level} = undef;
$parchmentObj->ivAdd('markedLabelHash', $mapLabelObj->number, $mapLabelObj);
}
# We'll need a canvas widget at level 0, even if there are no rooms/labels at that
# level, in the expectation that we're going to need it
$occupyHash{0} = undef;
# At each occupied level, create a canvas widget
foreach my $level (keys %occupyHash) {
$self->createMap($regionmapObj, $parchmentObj, $level);
}
}
# If there's a current room and it is in this region, and assuming that we are in
# follow/update mode (or if the calling function set $forceFlag to TRUE), and if that
# room's map level isn't the one that's about to be displayed, change the current
# level to the one containing the room
$currentRoom = $self->mapObj->currentRoom;
if (
($self->mode eq 'follow' || $self->mode eq 'update' || $forceFlag)
&& $currentRoom
&& $currentRoom->parent # Check that the room is in a region
&& $self->currentRegionmap->number == $currentRoom->parent
&& $self->currentRegionmap->currentLevel != $currentRoom->zPosBlocks
) {
# Set the new current level to the same level as the current room
$self->setCurrentLevel(
$currentRoom->zPosBlocks,
TRUE, # Don't call ->showRegion yet
);
}
# Change the window title to display the current region
$self->setWinTitle();
# Redraw the menu bar and title bar, so that the various checkbuttons/radiobuttons are
# showing settings for the new current region
$self->redrawWidgets('menu_bar', 'toolbar');
# Make sure all canvas objects on the new current region's current level have been drawn
# (i.e. aren't in the queue to be drawn)
$self->showRegion();
# If ->showRegion's call to ->doDraw failed, because a drawing cyle was already in progress,
# $self->winUpdateForceFlag will be set. If we change the visible canvas widget now, the
# user will see a half-drawn map. Instead, let's wait for the next call to
# $self->winUpdate
if ($self->winUpdateForceFlag) {
# Wait for the next call to $self->winUpdate
$self->ivPoke('winUpdateShowFlag', TRUE);
} else {
# Make the current region visible now
$self->swapCanvasWidget();
}
# If an old parchment object is marked to be destroyed, and hasn't been destroyed yet, then
# perform that operation
if ($destroyObj) {
$self->ivDelete('parchmentHash', $destroyObj->name);
$self->ivDelete('parchmentReadyHash', $destroyObj->name);
$index = $self->ivFind('parchmentQueueList', $destroyObj);
if (defined $index) {
$self->ivSplice('parchmentQueueList', $index, 1);
# (Need to update the window's title bar again, just in case)
$self->setWinTitle();
}
}
return 1;
}
sub setCurrentLevel {
# Can be called by anything
# Changes the current regionmap's currently level, and redraws the map to show this level
#
# Expected arguments
# $level - The new current level, matching GA::Obj::Regionmap->currentLevel
#
# Optional arguments
# $noDrawFlag - If set to TRUE, this function doesn't call ->drawRegion or
# ->showRegion, because the calling function is going to call it
# anyway (and we don't want to do the drawing operation twice).
# Otherwise set to FALSE (or 'undef')
#
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $level, $noDrawFlag, $check) = @_;
# Local variables
my ($scrollXPos, $scrollYPos, $oldLevel, $high, $low);
# Check for improper arguments
if (! defined $level || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setCurrentLevel', @_);
}
# Store the current position of the scrollbars so that the new level's canvas widget is
# displayed at the same position
($scrollXPos, $scrollYPos) = $self->getMapPosn();
$self->currentRegionmap->ivPoke('scrollXPos', $scrollXPos);
$self->currentRegionmap->ivPoke('scrollYPos', $scrollYPos);
# Temporarily remember the old level
$oldLevel = $self->currentRegionmap->currentLevel;
# Set the new level
$self->currentRegionmap->ivPoke('currentLevel', $level);
# If a canvas widget for this level doesn't exist, create it
if (! $self->currentParchment->ivExists('canvasWidgetHash', $level)) {
$self->createMap(
$self->currentRegionmap,
$self->currentParchment,
$level,
);
}
# Change the window's title
$self->setWinTitle();
if (! $noDrawFlag) {
# Make sure all canvas objects on the new current region's current level have been drawn
# (i.e. aren't in the queue to be drawn)
$self->showRegion();
# Make the canvas visible
$self->swapCanvasWidget();
}
# We can remove canvas widgets from the current parchment object, if they're no longer
# occupied
if (! defined $self->currentRegionmap->highestLevel) {
$high = 0;
$low = 0;
} else {
$high = $self->currentRegionmap->highestLevel;
$low = $self->currentRegionmap->lowestLevel;
}
if ($self->currentRegionmap->currentLevel > $high) {
$high = $self->currentRegionmap->currentLevel;
} elsif ($self->currentRegionmap->currentLevel < $low) {
$low = $self->currentRegionmap->currentLevel;
}
# Increase the highest/lowest occupied level by 1 so that room echos remain drawn
$high++;
$low--;
# Remove any redundant canvas widgets
foreach my $thisLevel ($self->currentParchment->ivKeys('canvasWidgetHash')) {
if ($thisLevel > $high || $thisLevel < $low) {
$self->currentParchment->ivDelete('canvasWidgetHash', $thisLevel);
$self->currentParchment->ivDelete('bgCanvasObjHash', $thisLevel);
$self->currentParchment->ivDelete('levelHash', $thisLevel);
}
}
return 1;
}
sub setSelectedObj {
# Called by $self->mouseClickEvent or any other function
# Sets the currently selected object(s) - rooms, room tags, room guilds, exits, exit tags
# and labels - or adds the object(s) to the existing hashes of selected objects
# Redraws the object(s) object along with any objects that are being unselected
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $listRef - If set, a reference to a list containing pairs of elements, each
# representing a room, room tag, room guild, exit, exit tag or label
# - The list is in the form (blessed_ref, mode, blessed_ref, mode...)
# where 'mode' is one of the strings 'room', 'exit', 'label',
# 'room_tag', 'room_guild' or 'exit_tag'
# $multipleFlag - If set to TRUE, the object(s) were selected while holding down the
# CTRL key, so the object(s) are added to any existing selected
# objects
# - If set to FALSE (or 'undef'), all existing selected objects are
# unselected, before the first object in $listRef is selected (the
# others are ignored)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $listRef, $multipleFlag, $check) = @_;
# Local variables
my (
$pairedRoomObj, $thisObj, $thisMode, $shadowExitObj,
@objList, @drawList,
%selectedRoomHash, %selectedRoomTagHash, %selectedRoomGuildHash, %selectedExitHash,
%selectedExitTagHash, %selectedLabelHash, %drawHash,
) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setSelectedObj', @_);
}
# Selected broken/region exits have a paired twin exit and its parent room, which are drawn
# a different colour. Whatever the new selected object(s) is going to be, a paired exit &
# room must be reset and marked to be redrawn, if they exist
if ($self->pairedTwinRoom) {
# (Redrawing the paired room also redraws its paired exit, if there is one)
$pairedRoomObj = $self->pairedTwinRoom;
$self->ivUndef('pairedTwinRoom');
$self->ivUndef('pairedTwinExit');
# Mark the room to be redrawn
$self->markObjs('room', $pairedRoomObj);
}
# For quick lookup, import the hashes of selected rooms, room tags, room guilds, exits,
# exit tags and labels
# NB No need to import the scalar IVs ->selectedRoom, ->selectedExit, etc
%selectedRoomHash = $self->selectedRoomHash;
%selectedRoomTagHash = $self->selectedRoomTagHash;
%selectedRoomGuildHash = $self->selectedRoomGuildHash;
%selectedExitHash = $self->selectedExitHash;
%selectedExitTagHash = $self->selectedExitTagHash;
%selectedLabelHash = $self->selectedLabelHash;
# Get the list referenced by $listRef (if it was specified - if not, use an empty list)
if ($listRef) {
@objList = @$listRef;
}
# If $multipleFlag isn't set to TRUE, $$listRef[0] is the only object which should now be
# drawn as selected
if (! $multipleFlag) {
# @objList should contain 0 or 2 elements, representing 0 or 1 selected objects. If
# there are more selected objects in the list, ignore all but the first one
if (@objList > 2) {
$thisObj = shift @objList;
$thisMode = shift @objList;
@objList = ($thisObj, $thisMode);
}
# Mark all existing selected objects as no longer selected, and add them to the redraw
# list
if ($self->selectedRoom) {
push (@drawList, 'room', $self->selectedRoom);
$self->ivUndef('selectedRoom');
}
if (%selectedRoomHash) {
foreach my $number (keys %selectedRoomHash) {
push (@drawList, 'room', $selectedRoomHash{$number});
}
%selectedRoomHash = ();
}
if ($self->selectedRoomTag) {
push (@drawList, 'room_tag', $self->selectedRoomTag);
$self->ivUndef('selectedRoomTag');
}
if (%selectedRoomTagHash) {
foreach my $number (keys %selectedRoomTagHash) {
push (@drawList, 'room_tag', $selectedRoomTagHash{$number});
}
%selectedRoomTagHash = ();
}
if ($self->selectedRoomGuild) {
push (@drawList, 'room_guild', $self->selectedRoomGuild);
$self->ivUndef('selectedRoomGuild');
}
if (%selectedRoomGuildHash) {
foreach my $number (keys %selectedRoomGuildHash) {
push (@drawList, 'room_guild', $selectedRoomGuildHash{$number});
}
%selectedRoomGuildHash = ();
}
if ($self->selectedExit) {
push (@drawList, 'exit', $self->selectedExit);
# If the selected exit has a shadow exit, the shadow exit will be drawn a different
# colour, so it must also be redrawn
if ($self->selectedExit->shadowExit) {
$shadowExitObj = $self->worldModelObj->ivShow(
'exitModelHash',
$self->selectedExit->shadowExit,
);
if ($shadowExitObj) {
push (@drawList, 'exit', $shadowExitObj);
}
}
$self->ivUndef('selectedExit');
}
if (%selectedExitHash) {
foreach my $number (keys %selectedExitHash) {
push (@drawList, 'exit', $selectedExitHash{$number});
}
%selectedExitHash = ();
}
if ($self->selectedExitTag) {
push (@drawList, 'exit_tag', $self->selectedExitTag);
$self->ivUndef('selectedExitTag');
}
if (%selectedExitTagHash) {
foreach my $number (keys %selectedExitTagHash) {
push (@drawList, 'exit_tag', $selectedExitTagHash{$number});
}
%selectedExitTagHash = ();
}
if ($self->selectedLabel) {
push (@drawList, 'label', $self->selectedLabel);
$self->ivUndef('selectedLabel');
}
if (%selectedLabelHash) {
foreach my $id (keys %selectedLabelHash) {
push (@drawList, 'label', $selectedLabelHash{$id});
}
%selectedLabelHash = ();
}
}
# Now, select each object in turn (if any were specified), and add them to the redraw list
if (@objList) {
do {
my ($obj, $mode, $noSelectedFlag, $twinExitObj, $twinRoomObj);
$obj = shift @objList;
$mode = shift @objList;
# If there is already a single selected object, it must be moved from one IV to
# another before a second object is selected
if ($self->selectedRoom) {
$selectedRoomHash{$self->selectedRoom->number} = $self->selectedRoom;
$self->ivUndef('selectedRoom');
} elsif ($self->selectedRoomTag) {
$selectedRoomTagHash{$self->selectedRoomTag->number} = $self->selectedRoomTag;
$self->ivUndef('selectedRoomTag');
} elsif ($self->selectedRoomGuild) {
$selectedRoomGuildHash{$self->selectedRoomGuild->number}
= $self->selectedRoomGuild;
$self->ivUndef('selectedRoomGuild');
} elsif ($self->selectedExit) {
$selectedExitHash{$self->selectedExit->number} = $self->selectedExit;
$self->ivUndef('selectedExit');
} elsif ($self->selectedExitTag) {
$selectedExitTagHash{$self->selectedExitTag->number} = $self->selectedExitTag;
$self->ivUndef('selectedExitTag');
} elsif ($self->selectedLabel) {
$selectedLabelHash{$self->selectedLabel->id} = $self->selectedLabel;
$self->ivUndef('selectedLabel');
} elsif (
! %selectedRoomHash
&& ! %selectedRoomTagHash
&& ! %selectedRoomGuildHash
&& ! %selectedExitHash
&& ! %selectedExitTagHash
&& ! %selectedLabelHash
) {
# There are currently no selected objects at all
$noSelectedFlag = TRUE;
}
# Rooms
if ($mode eq 'room') {
push (@drawList, 'room', $obj);
if (! $noSelectedFlag) {
$selectedRoomHash{$obj->number} = $obj;
} else {
$self->ivPoke('selectedRoom', $obj);
}
# Room tags
} elsif ($mode eq 'room_tag') {
push (@drawList, 'room_tag', $obj);
if (! $noSelectedFlag) {
$selectedRoomTagHash{$obj->number} = $obj;
} else {
$self->ivPoke('selectedRoomTag', $obj);
}
# Room guilds
} elsif ($mode eq 'room_guild') {
push (@drawList, 'room_guild', $obj);
if (! $noSelectedFlag) {
$selectedRoomGuildHash{$obj->number} = $obj;
} else {
$self->ivPoke('selectedRoomGuild', $obj);
}
# Exits
} elsif ($mode eq 'exit') {
push (@drawList, 'exit', $obj);
if (! $noSelectedFlag) {
$selectedExitHash{$obj->number} = $obj;
} else {
$self->ivPoke('selectedExit', $obj);
# If the selected exit is a broken or region exit, we need to mark the
# destination room (and the twin exit, if there is one) to be drawn a
# different colour
# (NB Doesn't apply to bent broken exits)
if (
($obj->brokenFlag && ! $obj->bentFlag)
|| $obj->regionFlag
) {
$twinRoomObj
= $self->worldModelObj->ivShow('modelHash', $obj->destRoom);
if ($twinRoomObj) {
$self->ivPoke('pairedTwinRoom', $twinRoomObj);
}
if ($obj->twinExit) {
# Since the twin exit exists, it gets painted the same colour
$twinExitObj = $self->worldModelObj->ivShow(
'exitModelHash',
$obj->twinExit,
);
if ($twinExitObj) {
$self->ivPoke('pairedTwinExit', $twinExitObj);
}
} else {
# Make sure the IV has been reset
$self->ivUndef('pairedTwinExit');
}
# Redrawing the room redraws its exit
push (@drawList, 'room', $twinRoomObj);
}
}
# Exit tags
} elsif ($mode eq 'exit_tag') {
push (@drawList, 'exit_tag', $obj);
if (! $noSelectedFlag) {
$selectedExitTagHash{$obj->number} = $obj;
} else {
$self->ivPoke('selectedExitTag', $obj);
}
# Labels
} elsif ($mode eq 'label') {
push (@drawList, 'label', $obj);
if (! $noSelectedFlag) {
$selectedLabelHash{$obj->id} = $obj;
} else {
$self->ivPoke('selectedLabel', $obj);
}
}
} until (! @objList);
}
# Store the selected object hashes (any or all of which may be empty)
$self->ivPoke('selectedRoomHash', %selectedRoomHash);
$self->ivPoke('selectedRoomTagHash', %selectedRoomTagHash);
$self->ivPoke('selectedRoomGuildHash', %selectedRoomGuildHash);
$self->ivPoke('selectedExitHash', %selectedExitHash);
$self->ivPoke('selectedExitTagHash', %selectedExitTagHash);
$self->ivPoke('selectedLabelHash', %selectedLabelHash);
if (@drawList) {
# Redraw all objects that must be redrawn ($self->markObjs will eliminate any duplicates
# in @drawList)
$self->markObjs(@drawList);
$self->doDraw();
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
sub unselectObj {
# Called by $self->canvasEventHandler, ->canvasObjEventHandler and $self->deleteCanvasObj
# When an object is to be unselected, we need to be careful about updating the IVs. This
# function is called to see whether a room, room tag, room guild, exit, exit tag or label
# is selected and, if so, unselects it
#
# Expected arguments
# $obj - The object to be unselected. For rooms, exits and labels, a blessed reference
# of a GA::ModelObj::Room, GA::Obj::Exit or GA::Obj::MapLabel. For room tags
# and room guilds, the blessed reference of the GA::ModelObj::Room to which
# they belong. For exit tags, the blessed reference of the GA::Obj::Exit to
# which they belong
#
# Optional arguments
# $mode - Set to 'room_tag', 'room_guild', 'exit_tag' or 'undef' for everything else
# (i.e. rooms, exits and labels; so that we know that when $obj is a room
# object, whether it's the room itself, the room's room tag or its room guild
# which is to be selected; or so that we know whether to select an exit or an
# exit tag)
# $noRedrawFlag
# - Set to TRUE if the object shouldn't be redrawn (because it is about to be
# deleted)
#
# Return values
# 'undef' on improper arguments or if the object isn't already selected
# 1 otherwise
my ($self, $obj, $mode, $noRedrawFlag, $check) = @_;
# Local variables
my (
$singleObj, $singleType, $pairedRoomObj,
@drawList, @importList,
);
# Check for improper arguments
if (! defined $obj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->unselectObj', @_);
}
# Selected broken/region exits have a paired twin exit which is drawn a different colour,
# as is its parent room. Whatever objects are going to be unselected, a paired exit & room
# must be reset and redrawn, if they exist
if ($self->pairedTwinExit) {
# (Redrawing the paired room also redraws its paired exit, if there is one)
$pairedRoomObj = $self->pairedTwinRoom;
$self->ivUndef('pairedTwinRoom');
$self->ivUndef('pairedTwinExit');
# Mark the room to be redrawn
$self->markObjs('room', $pairedRoomObj);
}
# Unselect the object, and add it to the redraw list
if ($obj->_objClass eq 'Games::Axmud::ModelObj::Room') {
# Rooms
if (! $mode) {
push (@drawList, 'room', $obj);
if ($self->selectedRoom && $self->selectedRoom eq $obj) {
$self->ivUndef('selectedRoom');
} elsif ($self->ivExists('selectedRoomHash', $obj->number)) {
$self->ivDelete('selectedRoomHash', $obj->number);
} else {
# This room wasn't already selected
return undef;
}
# Room tags
} elsif ($mode eq 'room_tag') {
push (@drawList, 'room_tag', $obj);
if ($self->selectedRoomTag && $self->selectedRoomTag eq $obj) {
$self->ivUndef('selectedRoomTag');
} elsif ($self->ivExists('selectedRoomTagHash', $obj->number)) {
$self->ivDelete('selectedRoomTagHash', $obj->number);
} else {
# This room tag wasn't already selected
return undef;
}
# Room guilds
} elsif ($mode eq 'room_guild') {
push (@drawList, 'room_guild', $obj);
if ($self->selectedRoomGuild && $self->selectedRoomGuild eq $obj) {
$self->ivUndef('selectedRoomGuild');
} elsif ($self->ivExists('selectedRoomGuildHash', $obj->number)) {
$self->ivDelete('selectedRoomGuildHash', $obj->number);
} else {
# This room guild wasn't already selected
return undef;
}
}
} elsif ($obj->_objClass eq 'Games::Axmud::Obj::Exit') {
# Exits
if (! $mode) {
push (@drawList, 'exit', $obj);
if ($self->selectedExit && $self->selectedExit eq $obj) {
$self->ivUndef('selectedExit');
} elsif ($self->ivExists('selectedExitHash', $obj->number)) {
$self->ivDelete('selectedExitHash', $obj->number);
} else {
# This exit wasn't already selected
return undef;
}
# Exit tags
} elsif ($mode eq 'exit_tag') {
push (@drawList, 'exit_tag', $obj);
if ($self->selectedExitTag && $self->selectedExitTag eq $obj) {
$self->ivUndef('selectedExitTag');
} elsif ($self->ivExists('selectedExitTagHash', $obj->number)) {
$self->ivDelete('selectedExitTagHash', $obj->number);
} else {
# This exit tag wasn't already selected
return undef;
}
}
# Labels
} elsif ($obj->_objClass eq 'Games::Axmud::Obj::MapLabel') {
push (@drawList, 'label', $obj);
if ($self->selectedLabel && $self->selectedLabel eq $obj) {
$self->ivUndef('selectedLabel');
} elsif ($self->ivExists('selectedLabelHash', $obj->id)) {
$self->ivDelete('selectedLabelHash', $obj->id);
} else {
# This label wasn't already selected
return undef;
}
}
# Redraw the item removed (unless it's about to be deleted)
if (! $noRedrawFlag) {
$self->markObjs(@drawList);
$self->doDraw();
}
# Now, we check these five hashes. If, between them, they contain a single selected object,
# then we need to move it out of the hashes and into the IVs $self->selectedRoom,
# ->selectedExit (etc)
if ($self->ivPairs('selectedRoomHash') == 1) {
@importList = $self->selectedRoomHash;
$singleObj = $importList[1];
$singleType = 'room';
}
if ($self->ivPairs('selectedRoomTagHash') == 1) {
if ($singleObj) {
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# More than one selected object. Give up
return 1;
} else {
@importList = $self->selectedRoomTagHash;
$singleObj = $importList[1];
$singleType = 'room_tag';
}
}
if ($self->ivPairs('selectedRoomGuildHash') == 1) {
if ($singleObj) {
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# More than one selected object. Give up
return 1;
} else {
@importList = $self->selectedRoomGuildHash;
$singleObj = $importList[1];
$singleType = 'room_guild';
}
}
if ($self->ivPairs('selectedExitHash') == 1) {
if ($singleObj) {
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# More than one selected object. Give up
return 1;
} else {
@importList = $self->selectedExitHash;
$singleObj = $importList[1];
$singleType = 'exit';
}
}
if ($self->ivPairs('selectedExitTagHash') == 1) {
if ($singleObj) {
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# More than one selected object. Give up
return 1;
} else {
@importList = $self->selectedExitTagHash;
$singleObj = $importList[1];
$singleType = 'exit_tag';
}
}
if ($self->ivPairs('selectedLabelHash') == 1) {
if ($singleObj) {
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# More than one selected object. Give up
return 1;
} else {
@importList = $self->selectedLabelHash;
$singleObj = $importList[1];
$singleType = 'label';
}
}
if ($singleObj) {
# There is exactly one selected object left in the six hashes. Remove it from its hash,
# and set the single-object IV
if ($singleType eq 'room') {
$self->ivEmpty('selectedRoomHash');
$self->ivPoke('selectedRoom', $singleObj);
} elsif ($singleType eq 'room_tag') {
$self->ivEmpty('selectedRoomTagHash');
$self->ivPoke('selectedRoomTag', $singleObj);
} elsif ($singleType eq 'room_guild') {
$self->ivEmpty('selectedRoomGuildHash');
$self->ivPoke('selectedRoomGuild', $singleObj);
} elsif ($singleType eq 'exit') {
$self->ivEmpty('selectedExitHash');
$self->ivPoke('selectedExit', $singleObj);
} elsif ($singleType eq 'exit_tag') {
$self->ivEmpty('selectedExitTagHash');
$self->ivPoke('selectedExitTag', $singleObj);
} elsif ($singleType eq 'label') {
$self->ivEmpty('selectedLabelHash');
$self->ivPoke('selectedLabel', $singleObj);
}
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
# Graphical operations - window and background
sub setWinTitle {
# Called by GA::Task::Locator->refreshWin or by any other function
# Sets the Automapper window's title. If there is a current region and/or a current level,
# both are displayed in the title bar
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $optionalText - Text to be displayed after the usual text
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $optionalText, $check) = @_;
# Local variables
my ($parchmentObj, $text, $upFlag, $downFlag, $regionCount, $worldCount);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setWinTitle', @_);
}
# If pre-drawing operatiosn are taking place, get the partially-drawn parchment object
if ($self->parchmentQueueList) {
$parchmentObj = $self->ivFirst('parchmentQueueList');
}
if ($self->currentRegionmap) {
if (defined $self->currentRegionmap->currentLevel) {
# Show both the current map and the current level
$text = 'Automapper [' . $self->currentRegionmap->name . ', level '
. $self->currentRegionmap->currentLevel . ']';
# Show arrows if higher/lower levels are occupied
if (
defined $self->currentRegionmap->highestLevel
&& $self->currentRegionmap->currentLevel < $self->currentRegionmap->highestLevel
) {
$upFlag = TRUE;
}
if (
defined $self->currentRegionmap->lowestLevel
&& $self->currentRegionmap->currentLevel > $self->currentRegionmap->lowestLevel
) {
$downFlag = TRUE;
}
# Use either arrows or empty space so that the text stays in roughly the same place
if ($upFlag) {
$text .= ' /\\';
} else {
$text .= ' ';
}
if ($downFlag) {
$text .= ' \\/';
} else {
$text .= ' ';
}
# If pre-drawing operations are taking place, show the partially-drawn region
if ($parchmentObj) {
$text .= ' (Drawing ' . $parchmentObj->name . ')';
# If graffiti mode is on, show room counts
} elsif ($self->graffitiModeFlag) {
$regionCount = 0;
$worldCount = 0;
foreach my $roomNum ($self->ivKeys('graffitiHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
if ($roomObj) {
$worldCount++;
if ($roomObj->parent == $self->currentRegionmap->number) {
$regionCount++;
}
}
}
$text .= ' (' . $regionCount . '/'
. $self->currentRegionmap->ivPairs('gridRoomHash')
. ', ' . $worldCount . '/'
. $self->worldModelObj->ivPairs('roomModelHash') . ')';
}
} else {
# Show just the current region
$text = 'Automapper [' . $self->currentRegionmap->name . ']';
if ($parchmentObj) {
$text .= ' (Drawing ' . $parchmentObj->name . ')';
}
}
} else {
# Don't show the current region
$text = 'Automapper';
if ($parchmentObj) {
$text .= ' (Drawing ' . $parchmentObj->name . ')';
}
}
# Add optional text, if any was specified
if ($optionalText) {
$text .= ' ' . $optionalText;
}
# Write the text to the title
if ($self->pseudoWinTableObj) {
$self->pseudoWinTableObj->set_frameTitle($text);
} else {
$self->winWidget->set_title($text);
}
return 1;
}
sub preparePreDraw {
# Called by $self->winUpdate (on the first call to that function since the window opened or
# was reset)
# Compiles a list of regions that should be pre-drawn using background processes (i.e.
# regular calls to $self->winUpdate). For any regions selected, creates parchment objects
# (GA::Obj::Parchment) ready for the drawing functions to use, and creates a queue of
# rooms and labels to draw in each parchment
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$firstRegion,
@sortedList,
%regionHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->preparePreDraw', @_);
}
# Any regions that contain more rooms than the number specified by
# GA::Obj::WorldModel->preDrawMinRooms must be added to the queue now
if ($self->worldModelObj->preDrawAllowFlag) {
# Compile a hash of affected regionmaps. Store the number of rooms so we can draw those
# regions, largest first
foreach my $regionmapObj ($self->worldModelObj->ivValues('regionmapHash')) {
my $count = $regionmapObj->ivPairs('gridRoomHash');
if ($count > $self->worldModelObj->preDrawMinRooms) {
$regionHash{$regionmapObj->name} = $count;
}
}
# If GA::Obj::WorldModel->firstRegion is set and it's going to be pre-drawn, draw it
# first
$firstRegion = $self->worldModelObj->firstRegion;
if (defined $firstRegion && $regionHash{$firstRegion}) {
push (@sortedList, $firstRegion);
delete $regionHash{$firstRegion};
}
push (@sortedList, sort {$regionHash{$b} <=> $regionHash{$a}} (keys %regionHash));
# If obscuring exits is enabled, compile a hash of rooms whose exits should be drawn -
# rooms near the current room, selected rooms (and any selected exits), and rooms
# whose room flags match those in GA::Client->constRoomNoObscuredHash (e.g.
# 'main_route')
# This hash is cummulatively populated by successive calls to ->compileNoObscuredRooms
# below
$self->ivEmpty('noObscuredRoomHash');
# This hash is intentionally left empty (we don't need to selectively destroy exit
# canvas objects, if the whole region is being redrawn)
$self->ivEmpty('reObscuredRoomHash');
# Now set up pre-drawing of all the regions in @sortedList
foreach my $name (@sortedList) {
my (
$regionmapObj, $parchmentObj, $exitMode, $obscuredFlag,
%occupyHash,
);
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $name);
# Create a new parchment object
$parchmentObj = Games::Axmud::Obj::Parchment->new($name, $self->worldModelObj);
$self->ivAdd('parchmentHash', $name, $parchmentObj);
$self->ivUnshift('parchmentQueueList', $parchmentObj);
# Create a hash of levels in the region that are occupied by rooms and/or labels
# (exits can't exist independently of rooms, so no need to check them)
# At the same time, add all rooms and labels to the drawing queue. If room echoes
# aren't allowed to be drawn, we can skip that stage in the queue
if ($self->worldModelObj->drawRoomEchoFlag) {
foreach my $roomNum ($regionmapObj->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
$occupyHash{$roomObj->zPosBlocks} = undef;
# (Room echoes are drawn first, followed by other room features)
$parchmentObj->ivAdd('queueRoomEchoHash', $roomObj->number, $roomObj);
}
} else {
# No room echoes drawn, so start each room by drawings its room box
foreach my $roomNum ($regionmapObj->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
$occupyHash{$roomObj->zPosBlocks} = undef;
# (Room boxes are drawn first, followed by other room features)
$parchmentObj->ivAdd('queueRoomBoxHash', $roomObj->number, $roomObj);
}
}
foreach my $mapLabelObj ($regionmapObj->ivValues('gridLabelHash')) {
$occupyHash{$mapLabelObj->level} = undef;
$parchmentObj->ivAdd('queueLabelHash', $mapLabelObj->number, $mapLabelObj);
}
# Decide how exits are drawn. GA::Obj::WorldModel->drawExitMode is one of the values
# 'ask_regionmap', 'no_exit', 'simple_exit' and 'complex_exit'. The regionmap's
# ->drawExitMode is any of these values except 'ask_regionmap'
if ($self->drawRegionmap && $self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $self->drawRegionmap->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# Decide whether some exits should be obscured, or not
if ($self->drawRegionmap && $self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$obscuredFlag = $self->drawRegionmap->obscuredExitFlag;
} else {
$obscuredFlag = $self->worldModelObj->obscuredExitFlag;
}
# Get obscured rooms (if any) for this region, and add them to the main hash. The
# TRUE argument means that rooms will be drawn via calls to ->doQuickDraw
$self->compileNoObscuredRooms(
$parchmentObj,
$exitMode,
$obscuredFlag,
FALSE, # Don't mark previously unobscured rooms to be redrawn
TRUE, # The caller is this function, not $self->doDraw
);
foreach my $key ($parchmentObj->ivKeys('noObscuredRoomHash')) {
$self->ivAdd('noObscuredRoomHash', $key, undef);
}
# Create a canvas widget at level 0, even if there are no rooms/labels at that
# level, in the expectation that we're going to need it
$occupyHash{0} = undef;
# Add a canvas widget for each of these levels
foreach my $level (keys %occupyHash) {
$self->createMap($regionmapObj, $parchmentObj, $level);
}
}
}
# Show the next region to be pre-drawn (if any) in the window's title bar
$self->setWinTitle();
return 1;
}
sub resetMap {
# Can be called by anything (first called by $self->enableCanvas)
# Draws an empty (default white) background map
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $colour;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetMap', @_);
}
# If an empty background map is already visible, there's nothing to do
if ($self->emptyMapFlag) {
return 1;
}
# If the tooltips are visible, hide them
$self->hideTooltips();
# Create the canvas widget
my $canvasWidget = GooCanvas2::Canvas->new();
# Add the canvas widget to its scrolled window and set its default size
$canvasWidget->set_size_request(
$self->worldModelObj->defaultMapWidthPixels,
$self->worldModelObj->defaultMapHeightPixels,
);
$canvasWidget->set_bounds(
0,
0,
$self->worldModelObj->defaultMapWidthPixels,
$self->worldModelObj->defaultMapHeightPixels,
);
$canvasWidget->set_scale(1);
foreach my $child ($self->canvasScroller->get_children()) {
$self->canvasScroller->remove($child);
}
$self->canvasScroller->add($canvasWidget);
# Draw the background canvas object (default colour: white), encompassing the whole map
$colour = $self->worldModelObj->defaultNoBackgroundColour;
my $canvasObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
x => 0,
y => 0,
width => $self->worldModelObj->defaultMapWidthPixels,
height => $self->worldModelObj->defaultMapHeightPixels,
# 'line-width' => 2,
'stroke-color' => $colour,
'fill-color' => $colour,
);
# Update IVs
$self->ivPoke('canvas', $canvasWidget);
$self->ivPoke('canvasBackground', $canvasObj);
$self->ivPoke('emptyMapFlag', TRUE);
# The background canvas object created here is lower than any other canvas object
$canvasObj->lower();
# Set up the event handler for clicks on the background canvas object
$self->setupCanvasEvent($canvasObj);
return 1;
}
sub createMap {
# Called by $self->setCurrentRegion, ->setCurrentLevel, ->preparePreDraw and ->refreshMap
# Also called by the drawing functions ->drawRoom, ->drawLabel and ->drawRoomEcho if, for
# some reason, a canvas widget for the room's/label's level doesn't exist
#
# Creates a canvas widget for a single level in a single regionmap, and stores it in the
# region's parchment object
#
# Expected arguments
# $regionmapObj - The regionmap (GA::Obj::Regionmap)
# $parchmentObj - The parchment object (GA::Obj::Parchment) in which the canvas
# widget should be stored
# $level - The level drawn, matching a possible value of
# $regionmapObj->currentLevel
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $regionmapObj, $parchmentObj, $level, $check) = @_;
# Local variables
my ($canvasWidget, $schemeObj, $colour, $levelObj);
# Check for improper arguments
if (
! defined $regionmapObj || ! defined $parchmentObj || ! defined $level
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->createMap', @_);
}
# If the tooltips are visible, hide them
$self->hideTooltips();
# If the parchment object has been recycled and a canvas widget at this level already
# exists, use it; otherwise create a new one
$canvasWidget = $parchmentObj->ivShow('canvasWidgetHash', $level);
if (! $canvasWidget) {
$canvasWidget = GooCanvas2::Canvas->new();
}
# Set the default size
$canvasWidget->set_size_request(
$regionmapObj->mapWidthPixels,
$regionmapObj->mapHeightPixels,
);
$canvasWidget->set_bounds(
0,
0,
$regionmapObj->mapWidthPixels,
$regionmapObj->mapHeightPixels,
);
$canvasWidget->set_scale($regionmapObj->magnification);
# Handle mouse button scrolls from here
$canvasWidget->signal_connect('scroll-event' => sub {
my ($widget, $event) = @_;
if ($event->direction eq 'up') {
# Zoom in
$self->zoomCallback('in');
} elsif ($event->direction eq 'down') {
# Zoom out
$self->zoomCallback('out');
}
});
# Draw the background canvas object (default colour: cream), encompassing the whole map
$schemeObj = $self->worldModelObj->getRegionScheme($regionmapObj);
$colour = $schemeObj->backgroundColour;
my $canvasObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
x => 0,
y => 0,
width => $regionmapObj->mapWidthPixels,
height => $regionmapObj->mapHeightPixels,
# 'line-width' => 2,
'stroke-color' => $colour,
'fill-color' => $colour,
);
# Create a parchment level object to store all the canvas objects drawn on this $level
$levelObj = Games::Axmud::Obj::ParchmentLevel->new($regionmapObj->name, $level);
# Update IVs
$parchmentObj->ivAdd('canvasWidgetHash', $level, $canvasWidget);
$parchmentObj->ivAdd('bgCanvasObjHash', $level, $canvasObj);
$parchmentObj->ivAdd('levelHash', $level, $levelObj);
# The background canvas object created here is lower than any other canvas object
$canvasObj->lower();
# Set up the event handler for clicks on the background canvas object
$self->setupCanvasEvent($canvasObj);
# Create eight slave canvas objects, hidden away in one corner of the map, so that we can
# arrange real canvas objects in the drawing stack easily
# (See the comments in GA::Obj::ParchmentLevel->new for a longer explanation)
for (my $count = 0; $count < 8; $count++ ) {
my $slaveObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
x => 0,
y => 0,
width => 0,
height => 0,
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
$levelObj->ivPush('slaveCanvasObjList', $slaveObj);
$slaveObj->raise();
}
# Draw coloured squares and rectangles for this level (but not for the default canvas)
if (defined $level) {
$self->doColourIn($regionmapObj, $level, $parchmentObj);
}
return 1;
}
sub refreshMap {
# Called by $self->redrawRegions (only)
# Refreshes a parchment object (GA::Obj::Parchment). The canvas widget (GooCanvas2::Canvas),
# along with any canvas objects drawon on it, are destroyed
# Then resets the parchment object's IVs
# Finally, creates new canvas widgets for every occupied level. It's up to the calling
# function to mark rooms/exits/labels to be drawn now, or to add them to the drawing queue
#
# Expected arguments
# $regionmapObj - The regionmap whose canvas widget should be refreshed. If not
# specified, $self->currentRegionmap is used
# $parchmentObj - The corresponding parchment object (GA::Obj::Parchment), if already
# known; otherwise this function fetches the corresponding parchment
# object
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 otherwise
my ($self, $regionmapObj, $parchmentObj, $check) = @_;
# Local variables
my (
$index,
%occupyHash,
);
# Check for improper arguments
if (! defined $regionmapObj || ! defined $parchmentObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->refreshMap', @_);
}
# The region is no longer completely drawn
$self->ivDelete('parchmentReadyHash', $regionmapObj->name);
# Remove the parchment from the queue; it's up to the calling function to decide if it
# should be added to the beginning of the queue, or the end
$index = $self->ivFind('parchmentQueueList', $parchmentObj);
if (defined $index) {
$self->ivSplice('parchmentQueueList', $index, 1);
}
# Destroy all canvas widgets (which destroys any canvas objects drawn on them)
foreach my $levelObj ($parchmentObj->ivValues('levelHash')) {
my $canvasWidget;
# Briefly store which levels are occupied by canvas objects
$occupyHash{$levelObj->level} = undef;
# Destory the canvas widgets
$canvasWidget = $parchmentObj->ivShow('canvasWidgetHash', $levelObj->level);
$canvasWidget->destroy();
}
# Reset parchment object IVs
$parchmentObj->ivEmpty('canvasWidgetHash');
$parchmentObj->ivEmpty('bgCanvasObjHash');
$parchmentObj->ivEmpty('levelHash');
$parchmentObj->ivEmpty('colouredSquareHash');
$parchmentObj->ivEmpty('colouredRectHash');
$parchmentObj->ivEmpty('markedRoomHash');
$parchmentObj->ivEmpty('markedRoomTagHash');
$parchmentObj->ivEmpty('markedRoomGuildHash');
$parchmentObj->ivEmpty('markedExitHash');
$parchmentObj->ivEmpty('markedExitTagHash');
$parchmentObj->ivEmpty('markedLabelHash');
$parchmentObj->ivEmpty('queueRoomEchoHash');
$parchmentObj->ivEmpty('queueRoomBoxHash');
$parchmentObj->ivEmpty('queueRoomTextHash');
$parchmentObj->ivEmpty('queueRoomExitHash');
$parchmentObj->ivEmpty('queueRoomInfoHash');
$parchmentObj->ivEmpty('queueLabelHash');
# Draw new canvas widgets for every occupied level, ready for the calling function to call
# $self->doDraw when it's ready
foreach my $level (keys %occupyHash) {
$self->createMap($regionmapObj, $parchmentObj, $level);
}
# Show the next region to be pre-drawn (if any) in the window's title bar
$self->setWinTitle();
return 1;
}
sub redrawRegions {
# Can be called by anything
# Redraws one or more regions. If there is a current regionmap and it's one of those which
# is to be redrawn, the drawing operation for the regionmap's current level takes place
# immediately. All other regions and levels are queued to be redrawn
# NB If GA::Obj::WorldModel->preDrawAllowFlag is FALSE, all parchment objects except the
# visible one are simply destroyed (since rooms, exits and labels can't be queued to be
# drawn)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $regionmapObj - The regionmap which should be drawn/redrawn. If not specified,
# $self->currentRegionmap is used
# $onlyFlag - If TRUE, only one regionmap (the specified one, or the current one if
# no regionmap is specified) is to be redrawn. If FALSE or 'undef',
# all regions for which a parchment object exists are redrawn
#
# Return values
# 'undef' on improper arguments or if there is nothing to redraw
# 1 otherwise
my ($self, $regionmapObj, $onlyFlag, $check) = @_;
# Local variables
my (
$doDrawFlag,
@parchmentList,
%regionHash, %markedRoomHash, %markedRoomTagHash, %markedRoomGuildHash, %markedExitHash,
%markedExitTagHash, %markedLabelHash, %queueRoomEchoHash, %queueRoomBoxHash,
%queueRoomTextHash, %queueRoomExitHash, %queueRoomInfoHash, %queueLabelHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->redrawRegions', @_);
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
if (! $regionmapObj && ! $self->parchmentHash) {
# There is nothing to redraw
return undef;
}
# Show a pause window, if necessary
if ($regionmapObj && $regionmapObj->ivPairs('gridRoomHash') > 500) {
# If the tooltips are visible, hide them
$self->hideTooltips();
# Show the pause window
$self->showPauseWin();
}
# Compile a list of parchment objects to redraw, starting with the one for which ->doDraw
# must be called now (all others are added to a queue)
if ($regionmapObj) {
push (@parchmentList, $self->ivShow('parchmentHash', $regionmapObj->name));
}
if (! $onlyFlag) {
# Prepare a hash of regionmaps and the number of rooms they contain, so we can add
# parchments objects to the queue, largest first
foreach my $thisRegionmapObj ($self->worldModelObj->ivValues('regionmapHash')) {
$regionHash{$thisRegionmapObj->name} = $thisRegionmapObj->ivPairs('gridRoomHash');
}
foreach my $thisParchmentObj (
sort {$regionHash{$b->name} <=> $regionHash{$a->name}}
($self->ivValues('parchmentHash'))
) {
if (! $regionmapObj || $regionmapObj->name ne $thisParchmentObj->name) {
push (@parchmentList, $thisParchmentObj);
}
}
}
# If obscuring exits is enabled, compile a hash of rooms whose exits should be drawn - rooms
# near the current room, selected rooms (and any selected exits), and rooms whose room
# flags match those in GA::Client->constRoomNoObscuredHash (e.g. 'main_route')
# The hash is cummulatively populated by successive calls to ->compileNoObscuredRooms below
$self->ivEmpty('noObscuredRoomHash');
# This hash is intentionally left empty (we don't need to selectively destroy exit
# canvas objects, if the whole region is being redrawn)
$self->ivEmpty('reObscuredRoomHash');
# Deal with each parchment object in turn
foreach my $thisParchmentObj (@parchmentList) {
my ($thisRegionmapObj, $exitMode, $obscuredFlag);
# Get the corresponding regionmap object
$thisRegionmapObj
= $self->worldModelObj->ivShow('regionmapHash', $thisParchmentObj->name);
# Refresh the parchment object, removing any canvas objects that have been drawn, ready
# for this function to draw new ones, and resetting the object's IVs
$self->refreshMap($thisRegionmapObj, $thisParchmentObj);
if ($self->currentRegionmap && $self->currentRegionmap eq $thisRegionmapObj) {
# Add the parchment object to the front of the queue. Canvas objects in the current
# level are drawn below; canvas objects on other levels are the first to be drawn
# by regular calls to $self->winUpdate
# (NB $self->refreshMap removed the parchment object from the queue, if it was due
# to be drawn)
$self->ivUnshift('parchmentQueueList', $thisParchmentObj);
# Mark any rooms and labels in the current level to be drawn now; rooms and labels
# on other levels are queued to be drawn
if ($self->worldModelObj->preDrawAllowFlag) {
# (If room echoes aren't allowed to be drawn, we can skip those drawing
# operations, and start drawing each room with its room box)
if ($self->worldModelObj->drawRoomEchoFlag) {
foreach my $roomNum ($thisRegionmapObj->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
if ($roomObj->zPosBlocks == $thisRegionmapObj->currentLevel) {
$thisParchmentObj->ivAdd('markedRoomHash', $roomNum, $roomObj);
} else {
$thisParchmentObj->ivAdd('queueRoomEchoHash', $roomNum, $roomObj);
}
}
} else {
foreach my $roomNum ($thisRegionmapObj->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $roomNum);
if ($roomObj->zPosBlocks == $thisRegionmapObj->currentLevel) {
$thisParchmentObj->ivAdd('markedRoomHash', $roomNum, $roomObj);
} else {
$thisParchmentObj->ivAdd('queueRoomBoxHash', $roomNum, $roomObj);
}
}
}
foreach my $mapLabelObj ($thisRegionmapObj->ivValues('gridLabelHash')) {
if ($mapLabelObj->level == $regionmapObj->currentLevel) {
$thisParchmentObj->ivAdd(
'markedLabelHash',
$mapLabelObj->number,
$mapLabelObj,
);
} else {
$thisParchmentObj->ivAdd(
'queueLabelHash',
$mapLabelObj->number,
$mapLabelObj,
);
}
}
} else {
# Nothing can be queued to be drawn, so mark everything to be drawn now
foreach my $roomNum ($thisRegionmapObj->ivValues('gridRoomHash')) {
$thisParchmentObj->ivAdd(
'markedRoomHash',
$roomNum,
$self->worldModelObj->ivShow('modelHash', $roomNum),
);
}
foreach my $mapLabelObj ($thisRegionmapObj->ivValues('gridLabelHash')) {
$thisParchmentObj->ivAdd(
'markedLabelHash',
$mapLabelObj->number,
$mapLabelObj,
);
}
}
# In the code just below, call ->doQuickDraw to draw all the marked rooms/labels
$doDrawFlag = TRUE;
} elsif ($self->worldModelObj->preDrawAllowFlag) {
# Add the parchment object to the end of the queue. Canvas objects on all levels are
# drawn by regular calls to $self->winUpdate
$self->ivPush('parchmentQueueList', $thisParchmentObj);
# Add all rooms and labels to the queue (any room tags, room guilds, exits or exits
# tags will be automatically drawn alongside them)
if ($self->worldModelObj->drawRoomEchoFlag) {
foreach my $roomNum ($thisRegionmapObj->ivValues('gridRoomHash')) {
$thisParchmentObj->ivAdd(
'queueRoomEchoHash',
$roomNum,
$self->worldModelObj->ivShow('modelHash', $roomNum),
);
}
} else {
foreach my $roomNum ($thisRegionmapObj->ivValues('gridRoomHash')) {
$thisParchmentObj->ivAdd(
'queueRoomBoxHash',
$roomNum,
$self->worldModelObj->ivShow('modelHash', $roomNum),
);
}
}
foreach my $mapLabelObj ($thisRegionmapObj->ivValues('gridLabelHash')) {
$thisParchmentObj->ivAdd('queueLabelHash', $mapLabelObj->number, $mapLabelObj);
}
}
# Decide how exits are drawn. GA::Obj::WorldModel->drawExitMode is one of the values
# 'ask_regionmap', 'no_exit', 'simple_exit' and 'complex_exit'. The regionmap's
# ->drawExitMode is any of these values except 'ask_regionmap'
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $thisRegionmapObj->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# Decide whether some exits should be obscured, or not
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$obscuredFlag = $thisRegionmapObj->obscuredExitFlag;
} else {
$obscuredFlag = $self->worldModelObj->obscuredExitFlag;
}
# Get obscured rooms (if any) for this region, and add them to the main hash. The TRUE
# argument means that rooms will be drawn via calls to ->doQuickDraw
$self->compileNoObscuredRooms(
$thisParchmentObj,
$exitMode,
$obscuredFlag,
FALSE, # Don't mark previously unobscured rooms to be redrawn
TRUE, # The caller is this function, not $self->doDraw
);
foreach my $key ($thisParchmentObj->ivKeys('noObscuredRoomHash')) {
$self->ivAdd('noObscuredRoomHash', $key, undef);
}
# Draw coloured squares and rectangles on the background map
$self->doColourIn($thisRegionmapObj, undef, $thisParchmentObj);
}
if ($doDrawFlag) {
# Perform a drawing cycle so that the current region can be redrawn, if it's one of
# those that has just been updated
# When drawing large numbers of rooms, the algorithm in ->doQuickDraw is quicker than
# the one in ->doDraw
# ->doQuickDraw acts on the IVs used for pre-drawing rooms/labels, a few at a time. In
# order to call it, we need to move rooms/labels which are marked to be drawn now
# into the IVs used for pre-drawing
# Temporarily store the marked and queued objects of ->queueRoomEchoHash (etc)
%markedRoomHash = $self->currentParchment->markedRoomHash;
%markedRoomTagHash = $self->currentParchment->markedRoomTagHash;
%markedRoomGuildHash = $self->currentParchment->markedRoomGuildHash;
%markedExitHash = $self->currentParchment->markedExitHash;
%markedExitTagHash = $self->currentParchment->markedExitTagHash;
%markedLabelHash = $self->currentParchment->markedLabelHash;
%queueRoomEchoHash = $self->currentParchment->queueRoomEchoHash;
%queueRoomBoxHash = $self->currentParchment->queueRoomBoxHash;
%queueRoomTextHash = $self->currentParchment->queueRoomTextHash;
%queueRoomExitHash = $self->currentParchment->queueRoomExitHash;
%queueRoomInfoHash = $self->currentParchment->queueRoomInfoHash;
%queueLabelHash = $self->currentParchment->queueLabelHash;
$self->currentParchment->reset_queueHash();
if ($self->worldModelObj->drawRoomEchoFlag) {
$self->currentParchment->ivPoke(
'queueRoomEchoHash',
$self->currentParchment->markedRoomHash,
);
} else {
$self->currentParchment->ivPoke(
'queueRoomBoxHash',
$self->currentParchment->markedRoomHash,
);
}
$self->currentParchment->ivPoke(
'queueLabelHash',
$self->currentParchment->markedLabelHash,
);
$self->currentParchment->reset_markedHash();
# Emptying those IVs means that the contents of ->drawCycleExitHash are now irrelevant
$self->ivEmpty('drawCycleExitHash');
if (! defined $self->doQuickDraw($self->currentParchment)) {
# Drawing cycle was already in operation. $self->winUpdate will try again; when it
# succeeds, make the replacement canvas widget visible
$self->ivPoke('winUpdateShowFlag', TRUE);
# Restore the parchment objects IVs to allow ->winUpdate to call both ->doDraw and
# ->doQuickDraw, as appropriate
$self->currentParchment->ivPoke('markedRoomHash', %markedRoomHash);
$self->currentParchment->ivPoke('markedRoomTagHash', %markedRoomTagHash);
$self->currentParchment->ivPoke('markedRoomGuildHash', %markedRoomGuildHash);
$self->currentParchment->ivPoke('markedExitHash', %markedExitHash);
$self->currentParchment->ivPoke('markedExitTagHash', %markedExitTagHash);
$self->currentParchment->ivPoke('markedLabelHash', %markedLabelHash);
$self->currentParchment->ivPoke('queueRoomEchoHash', %queueRoomEchoHash);
$self->currentParchment->ivPoke('queueRoomBoxHash', %queueRoomBoxHash);
$self->currentParchment->ivPoke('queueRoomTextHash', %queueRoomTextHash);
$self->currentParchment->ivPoke('queueRoomExitHash', %queueRoomExitHash);
$self->currentParchment->ivPoke('queueRoomInfoHash', %queueRoomInfoHash);
$self->currentParchment->ivPoke('queueLabelHash', %queueLabelHash);
} else {
# Make the replacement canvas widget visible
$self->swapCanvasWidget();
# Reset parchment object IVs
$self->currentParchment->ivPoke('queueRoomEchoHash', %queueRoomEchoHash);
$self->currentParchment->ivPoke('queueRoomBoxHash', %queueRoomBoxHash);
$self->currentParchment->ivPoke('queueRoomTextHash', %queueRoomTextHash);
$self->currentParchment->ivPoke('queueRoomExitHash', %queueRoomExitHash);
$self->currentParchment->ivPoke('queueRoomInfoHash', %queueRoomInfoHash);
$self->currentParchment->ivPoke('queueLabelHash', %queueLabelHash);
}
# The call to $self->doQuickDraw may have removed $self->currentParchment from the
# pre-drawing queue, in which case, we should re-insert it
if (
$self->currentParchment->queueRoomEchoHash
|| $self->currentParchment->queueRoomBoxHash
|| $self->currentParchment->queueRoomTextHash
|| $self->currentParchment->queueRoomExitHash
|| $self->currentParchment->queueRoomInfoHash
|| $self->currentParchment->queueLabelHash
&& $self->ivExists('parchmentReadyHash', $self->currentParchment->name)
) {
$self->ivUnshift('parchmentQueueList', $self->currentParchment);
$self->ivDelete('parchmentReadyHash', $self->currentParchment->name);
}
}
# Show the next region to be pre-drawn (if any) in the window's title bar
$self->setWinTitle();
# Make the pause window invisible, if visible
$self->hidePauseWin();
return 1;
}
sub showRegion {
# Called by $self->setCurrentRegion or ->setCurrentLevel (only)
# Checks all canvas objects in the current regionmap's queue of canvas objects to draw. Any
# objects on the current level which are in that queue are marked as needing to be drawn
# now
# Then calls $self->doDraw to draw them now
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if there's no current regionmap
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($regionmapObj, $level, $parchmentObj, $index);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->showRegion', @_);
}
# Import the current regionmap and parchment objects (for convenience)
if (! $self->currentRegionmap) {
return undef;
} else {
$regionmapObj = $self->currentRegionmap;
$level = $regionmapObj->currentLevel;
$parchmentObj = $self->currentParchment;
}
# Check all canvas objects in the drawing queue, and mark any which should be drawn now
foreach my $obj ($parchmentObj->ivValues('queueRoomEchoHash')) {
if ($obj->zPosBlocks == $level) {
$parchmentObj->ivAdd('markedRoomHash', $obj->number, $obj);
$parchmentObj->ivDelete('queueRoomEchoHash', $obj->number);
}
}
foreach my $obj ($parchmentObj->ivValues('queueRoomBoxHash')) {
if ($obj->zPosBlocks == $level) {
$parchmentObj->ivAdd('markedRoomHash', $obj->number, $obj);
$parchmentObj->ivDelete('queueRoomBoxHash', $obj->number);
}
}
foreach my $obj ($parchmentObj->ivValues('queueRoomTextHash')) {
if ($obj->zPosBlocks == $level) {
$parchmentObj->ivAdd('markedRoomHash', $obj->number, $obj);
$parchmentObj->ivDelete('queueRoomTextHash', $obj->number);
}
}
foreach my $obj ($parchmentObj->ivValues('queueRoomExitHash')) {
if ($obj->zPosBlocks == $level) {
$parchmentObj->ivAdd('markedRoomHash', $obj->number, $obj);
$parchmentObj->ivDelete('queueRoomExitHash', $obj->number);
}
}
foreach my $obj ($parchmentObj->ivValues('queueRoomInfoHash')) {
if ($obj->zPosBlocks == $level) {
$parchmentObj->ivAdd('markedRoomHash', $obj->number, $obj);
$parchmentObj->ivDelete('queueRoomInfoHash', $obj->number);
}
}
foreach my $obj ($parchmentObj->ivValues('queueLabelHash')) {
if ($obj->level == $level) {
$parchmentObj->ivAdd('markedLabelHash', $obj->number, $obj);
$parchmentObj->ivDelete('queueLabelHash', $obj->number);
}
}
# If any canvas objects need to be drawn, draw them now
if (
$parchmentObj->markedRoomHash
|| $parchmentObj->markedRoomTagHash
|| $parchmentObj->markedRoomGuildHash
|| $parchmentObj->markedExitHash
|| $parchmentObj->markedExitTagHash
|| $parchmentObj->markedLabelHash
) {
# If tooltips are visible, hide them
$self->hideTooltips();
# Draw the canvas object(s) (which empties $parchmentObj->markedRoomHash, etc)
if (
$self->doDraw()
&& ! $parchmentObj->queueRoomEchoHash
&& ! $parchmentObj->queueRoomBoxHash
&& ! $parchmentObj->queueRoomTextHash
&& ! $parchmentObj->queueRoomExitHash
&& ! $parchmentObj->queueRoomInfoHash
&& ! $parchmentObj->queueLabelHash
) {
# Mark this parchment object as fully drawn
$self->ivAdd('parchmentReadyHash', $parchmentObj->name, $parchmentObj);
$index = $self->ivFind('parchmentQueueList', $parchmentObj);
if (defined $index) {
$self->ivSplice('parchmentQueueList', $index, 1);
# Show the next region to be pre-drawn (if any) in the window's title bar
$self->setWinTitle();
}
}
}
return 1;
}
sub swapCanvasWidget {
# Called by $self->->winUpdate, ->setCurrentRegion, ->setCurrentLevel and ->redrawRegions
# Removes the visible canvas widget (GooCanvas2::Canvas), if any, and replaces it with the
# canvas widget for the current region's current level
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if there's no current regionmap
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my ($canvasWidget, $matchFlag);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->swapCanvasWidget', @_);
}
# Check that a current regionmap actually exists
if (! $self->currentRegionmap) {
return undef;
}
# For very large maps, if we simply remove the canvas widget (GooCanvas2::Canvas) from its
# scrolled window (Gtk3::ScrolledWindow), the user sees a grey background momentarily
# To avoid this, we have to take a roundabout route - create a new scrolled window, add the
# replacement canvas widget to it, call ->show_all
# Then we replace the old scrolled window with the new one
# Finally we remove the previous canvas widget from the defunct scrolled window, so it's
# ready for the next time it's made visible
# Get the replacement canvas widget
$canvasWidget = $self->currentParchment->ivShow(
'canvasWidgetHash',
$self->currentRegionmap->currentLevel,
);
if (! $canvasWidget) {
# This can happen if the user goes up to (say) level 5 in a region where level 5 is
# empty, then switches to a different visible region, then switches back to
# $self->currentRegionmap. Because the level is empty, no canvas widget has been
# created for it
# Solution is to set the default level (for which a canvas widget always exists,
# even if the level is empty)
$self->currentRegionmap->ivPoke('currentLevel', 0);
$canvasWidget = $self->currentParchment->ivShow('canvasWidgetHash', 0);
# Need to update the window title too
$self->setWinTitle();
}
# If the replacement canvas widget is the same as the previous canvas widget, the code below
# will fail (because the canvas widget will be given two parents)
# We need to check for that situation and, if detected, don't try to replace the canvas
# widget at all
OUTER: foreach my $child ($self->canvasScroller->get_children() ) {
if ($child eq $canvasWidget) {
$matchFlag = TRUE;
last OUTER;
}
}
if (! $matchFlag) {
# Create a new scrolled window
my $canvasScroller = Gtk3::ScrolledWindow->new();
my $canvasHAdjustment = $canvasScroller->get_hadjustment();
my $canvasVAdjustment = $canvasScroller->get_vadjustment();
$canvasScroller->set_border_width(3);
# Set the scrolling policy
$canvasScroller->set_policy('always','always');
# Add the replacement canvas widget to the new scrolled window
$canvasScroller->add($canvasWidget);
# The only way to scroll the map to the correct position, is to store the scrolled
# window's size allocation whenever it is set
$canvasScroller->signal_connect('size-allocate' => sub {
my ($widget, $hashRef) = @_;
$self->ivPoke('canvasScrollerWidth', $$hashRef{width});
$self->ivPoke('canvasScrollerHeight', $$hashRef{height});
});
# This line is the one that prevents the grey background from appearing momentarily
$canvasScroller->show_all();
# Remove the old canvas scroller from its parent Gtk3::Frame, and insert the new one
foreach my $child ($self->canvasFrame->get_children() ) {
$self->canvasFrame->remove($child);
}
$self->canvasFrame->add($canvasScroller);
# Remove the previous canvas widget from its scroller, ready to be re-inserted again at
# some point in the future
foreach my $child ($self->canvasScroller->get_children() ) {
$self->canvasScroller->remove($child);
}
# Update IVs
$self->ivPoke('canvas', $canvasWidget);
$self->ivPoke(
'canvasBackground',
$self->currentParchment->ivShow(
'bgCanvasObjHash',
$self->currentRegionmap->currentLevel,
),
);
$self->ivPoke('canvasScroller', $canvasScroller);
$self->ivPoke('canvasHAdjustment', $canvasHAdjustment);
$self->ivPoke('canvasVAdjustment', $canvasVAdjustment);
# Move the scrollbars to their former position
$self->setMapPosn(
$self->currentRegionmap->scrollXPos,
$self->currentRegionmap->scrollYPos,
);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
# Make sure the correct region is highlighted in the treeview region list
$self->treeViewSelectRow($self->currentRegionmap->name);
# Update IVs
$self->ivPoke('emptyMapFlag', FALSE);
return 1;
}
sub markObjs {
# Can be called by anything
# Called with a list of objects (rooms, room tags, room guilds, exits, exit tags or labels)
# that should be marked to be drawn on the next call to $self->doDraw (if they're on the
# current regionmap's current level), or else added to the queue to be drawn by
# background processes (if not)
# If the list contains any rooms, the room's associated room tags, room guilds, exits and
# exit tags are automatically redrawn when ->doDraw eventually gets called, so the calling
# code can specify either specify them or not
# If the objects are in a region for which no parchment object (GA::Obj::Parchment) exists,
# meaning that we don't want to draw the region at the moment, then the objects are
# ignored
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# @drawList - A list of objects to be drawn (or redrawn), in the form
# (type, object, type, object, ...)
# - ...where 'type' is one of the strings 'room', 'room_tag', 'room_guild',
# 'exit', 'exit_tag' and 'label', and 'object' is a GA::ModelObj::Room,
# GA::Obj::Exit or GA::Obj::MapLabel
#
# Return values
# 'undef' if an unrecognised 'type' is specified
# 1 otherwise (including when @drawList is empty)
my ($self, @drawList) = @_;
# Local variables
my ($currentRegion, $errorMsg);
# (No improper arguments to check)
# Import the current regionmap name, if any (to save time)
if ($self->currentRegionmap) {
$currentRegion = $self->currentRegionmap->name;
}
if (@drawList) {
do {
my ($type, $obj, $parchmentObj, $regionObj, $roomObj);
$type = shift @drawList;
$obj = shift @drawList;
if (! $obj) {
# Unrecognised $type; show the first error message at the end of this function
if (! $errorMsg) {
$errorMsg = 'Undefined object type in draw list';
}
# Mark the object to be drawn or add them to the queue
} elsif ($type eq 'room' || $type eq 'room_tag' || $type eq 'room_guild') {
$regionObj = $self->worldModelObj->ivShow('modelHash', $obj->parent);
$parchmentObj = $self->ivShow('parchmentHash', $regionObj->name);
# (Ignore objects for which no parchment object exists)
if ($parchmentObj) {
if (
$self->worldModelObj->preDrawAllowFlag
&& (! defined $currentRegion || $currentRegion ne $parchmentObj->name)
) {
if ($type eq 'room') {
$parchmentObj->ivAdd('queueRoomEchoHash', $obj->number, $obj);
} else {
$parchmentObj->ivAdd('queueRoomInfoHash', $obj->number, $obj);
}
} else {
if ($type eq 'room') {
$parchmentObj->ivAdd('markedRoomHash', $obj->number, $obj);
} elsif ($type eq 'room_tag') {
$parchmentObj->ivAdd('markedRoomTagHash', $obj->number, $obj);
} else {
$parchmentObj->ivAdd('markedRoomGuildHash', $obj->number, $obj);
}
}
}
} elsif ($type eq 'exit' || $type eq 'exit_tag') {
$roomObj = $self->worldModelObj->ivShow('modelHash', $obj->parent);
$regionObj = $self->worldModelObj->ivShow('modelHash', $roomObj->parent);
$parchmentObj = $self->ivShow('parchmentHash', $regionObj->name);
# (Ignore objects for which no parchment object exists)
if ($parchmentObj) {
if (
$self->worldModelObj->preDrawAllowFlag
&& (! defined $currentRegion || $currentRegion ne $parchmentObj->name)
) {
if ($type eq 'exit') {
$parchmentObj->ivAdd(
'queueRoomExitHash',
$roomObj->number,
$roomObj,
);
} elsif ($type eq 'exit_tag') {
$parchmentObj->ivAdd(
'queueRoomInfoHash',
$roomObj->number,
$roomObj,
);
}
} else {
if ($type eq 'exit') {
$parchmentObj->ivAdd('markedExitHash', $obj->number, $obj);
} elsif ($type eq 'exit_tag') {
$parchmentObj->ivAdd('markedExitTagHash', $obj->number, $obj);
}
}
}
} elsif ($type eq 'label') {
$parchmentObj = $self->ivShow('parchmentHash', $obj->region);
# (Ignore objects for which no parchment object exists)
if ($parchmentObj) {
if (
$self->worldModelObj->preDrawAllowFlag
&& (! defined $currentRegion || $currentRegion ne $parchmentObj->name)
) {
$parchmentObj->ivAdd('queueLabelHash', $obj->number, $obj);
} else {
$parchmentObj->ivAdd('markedLabelHash', $obj->number, $obj);
}
}
} else {
# Unrecognised $type; show the first error message at the end of this function
if (! $errorMsg) {
$errorMsg = 'Unrecognised object type \'' . $type . '\' in draw list';
}
}
} until (! @drawList);
}
# Operation complete
if ($errorMsg) {
return $self->session->writeError(
$errorMsg,
$self->_objClass . '->markObjs',
);
}
return 1;
}
# Graphical operations - background colouring
sub doColourIn {
# Called by $self->redrawRegions and ->createMap
# Draws all coloured blocks and rectangles for the specified regionmap
#
# Expected arguments
# $regionmapObj - The regionmap (GA::Obj::Regionmap) on which to draw
#
# Optional arguments
# $level - The level (matches a possible value of
# GA::Obj::Regionmap->currentLevel). If not specified, coloured blocks
# and rectangles are drawn on every level
# $parchmentObj - The regionmap's corresponding parchment object, if known. If 'undef',
# this function fetches it
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $regionmapObj, $level, $parchmentObj, $check) = @_;
# Local variables
my (%blockHash, %objHash);
# Check for improper arguments
if (! defined $regionmapObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doColourIn', @_);
}
# A single call to $self->doDraw represents a single drawing cycle. Don't allow a drawing
# cycle to take place while this function is working
$self->ivPoke('delayDrawFlag', TRUE);
# Fetch the parchment object, if none was specified
if (! $parchmentObj) {
$parchmentObj = $self->ivShow('parchmentHash', $regionmapObj->name);
}
# Colour in individual gridblocks. Import the IV for speed
%blockHash = $regionmapObj->gridColourBlockHash;
foreach my $coord (%blockHash) {
my ($x, $y, $z, $colour);
# $coord is in the form 'x_y_z' or 'x_y'
($x, $y, $z) = split (/_/, $coord);
$colour = $blockHash{$coord};
# $z, representing the level, can be undefined. There's no reason why $x and $y should
# be undefined, but we'll check anyway
if (defined $y && defined $colour) {
if (! defined $level) {
# Draw on every level
$self->drawColouredSquare($regionmapObj, $colour, $x, $y, undef, $parchmentObj);
} elsif (! defined $z || $z == $level) {
# Draw on a single level
$self->drawColouredSquare(
$regionmapObj,
$colour,
$x,
$y,
$level,
$parchmentObj,
);
}
}
}
# Colour in rectangles, stored as GA::Obj::GridColour objects. Because they may overlap,
# they must be drawn in a consistent order
%objHash = $regionmapObj->gridColourObjHash;
foreach my $obj (
sort {$a->number <=> $b->number}
($regionmapObj->ivValues('gridColourObjHash'))
) {
$self->drawColouredRect($regionmapObj, $obj, $level, $parchmentObj);
}
# Allow new drawing cycles to take place
$self->ivPoke('delayDrawFlag', FALSE);
return 1;
}
sub drawColouredSquare {
# Called by $self->doColourIn and ->setColouredSquare
# Draws a coloured square in the specified regionmap. The coloured square comprises the
# space occupied by a single gridblock
#
# Expected arguments
# $regionmapObj - The regionmap (GA::Obj::Regionmap) on which to draw
# $colour - The RGB colour to use, e.g. '#ABCDEF' (case-insensitive)
# $x - The block's x coordinate
# $y - The block's y coordinate
#
# Optional arguments
# $level - The block's z coordinate. If undefined, the coloured square is drawn
# on all levels
# $parchmentObj - The regionmap's corresponding parchment object, if known. If 'undef',
# this function fetches it
#
# Return values
# 'undef' on improper arguments or if the block can't be coloured in
# 1 otherwise
my ($self, $regionmapObj, $colour, $x, $y, $level, $parchmentObj, $check) = @_;
# Local variables
my (
$blockWidth, $blockHeight, $xPos, $yPos,
@list,
);
# Check for improper arguments
if (
! defined $regionmapObj || ! defined $colour || ! defined $x || ! defined $y
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawColouredSquare', @_);
}
# Fetch the parchment object, if none was specified
if (! $parchmentObj) {
$parchmentObj = $self->ivShow('parchmentHash', $regionmapObj->name);
}
# Compile a list of levels on which the coloured square should be drawn
if (! defined $level) {
push (@list, $parchmentObj->ivKeys('canvasWidgetHash'));
} else {
push (@list, $level);
}
# Get the block width/height, in pixels
$blockWidth = $regionmapObj->blockWidthPixels;
$blockHeight = $regionmapObj->blockHeightPixels;
# Get the position of the gridblock (it's the same on each level)
$xPos = $x * $blockWidth;
$yPos = $y * $blockHeight;
# Draw a coloured square on each of those levels
OUTER: foreach my $z (@list) {
my ($coord, $canvasWidget, $newObj, $levelObj);
# Before drawing the canvas object for this coloured square, destroy the existing canvas
# object from the last time the square was drawn
$coord = $x . '_' . $y . '_' . $z;
$self->deleteCanvasObj('square', $coord, $regionmapObj, $parchmentObj);
# Get the canvas widget for this level
$canvasWidget = $parchmentObj->ivShow('canvasWidgetHash', $z);
# Draw the canvas object
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $xPos,
'y' => $yPos,
'width' => $blockWidth,
'height' => $blockHeight,
'line-width' => 0,
# 'stroke-color' => $colour,
'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $parchmentObj->ivShow('levelHash', $z);
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 0));
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('square', $newObj);
# Store the canvas object
$parchmentObj->ivAdd('colouredSquareHash', $coord, $newObj);
}
return 1;
}
sub drawColouredRect {
# Called by $self->doColourIn and ->setColouredRect
# Draws a coloured rectangle in the specified regionmap. The coloured rectangle comprises
# the space occupied by multiple gridblocks in a rectangular shape (either or both of the
# x and y dimensions can have a length of a single gridblock, so it doesn't have to be
# rectangular)
#
# Expected arguments
# $regionmapObj - The regionmap (GA::Obj::Regionmap) on which to draw
# $colourObj - The grid colour object (GA::Obj::GridColour) which stores details of
# the rectangle's size, position and colour
#
# Optional arguments
# $level - The rectangle's z coordinate. If defined, the rectangle can only be
# drawn on that level (and won't be drawn at all, if the grid colour
# object itself specifies a different level). If not defined, the
# grid colour object specifies on which levels the rectangle should be
# drawn
# $parchmentObj - The regionmap's corresponding parchment object, if known. If 'undef',
# this function fetches it
#
# Return values
# 'undef' on improper arguments or if the rectangle can't be coloured in
# 1 otherwise
my ($self, $regionmapObj, $colourObj, $level, $parchmentObj, $check) = @_;
# Local variables
my (
$blockWidth, $blockHeight,
@list,
);
# Check for improper arguments
if (! defined $regionmapObj || ! defined $colourObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawColouredRect', @_);
}
# Fetch the parchment object, if none was specified
if (! $parchmentObj) {
$parchmentObj = $self->ivShow('parchmentHash', $regionmapObj->name);
}
# Compile a list of levels on which the coloured rectangle should be drawn
if (! defined $level) {
if (! defined $colourObj->level) {
push (@list, $parchmentObj->ivKeys('canvasWidgetHash'));
} else {
push (@list, $colourObj->level);
}
} elsif (! defined $colourObj->level || $colourObj->level == $level) {
push (@list, $level);
}
# Get the block width/height, in pixels
$blockWidth = $regionmapObj->blockWidthPixels;
$blockHeight = $regionmapObj->blockHeightPixels;
# Draw a coloured rectangle on each of those levels
OUTER: foreach my $z (@list) {
my ($key, $canvasWidget, $newObj, $levelObj);
# Before drawing the canvas object for this coloured rectangle, destroy the existing
# canvas object from the last time the rectangle was drawn
$key = $colourObj->number . '_' . $z;
$self->deleteCanvasObj('rect', $key, $regionmapObj, $parchmentObj);
# Get the canvas widget for this level
$canvasWidget = $parchmentObj->ivShow('canvasWidgetHash', $z);
# Draw the canvas object
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $colourObj->x1 * $blockWidth,
'y' => $colourObj->y1 * $blockHeight,
'width' => ($colourObj->x2 - $colourObj->x1 + 1) * $blockWidth,
'height' => ($colourObj->y2 - $colourObj->y1 + 1) * $blockHeight,
'line-width' => 0,
# 'stroke-color' => $colourObj->colour,
'fill-color' => $colourObj->colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $parchmentObj->ivShow('levelHash', $z);
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 1));
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('rect', $newObj);
# Store the canvas object
$parchmentObj->ivAdd('colouredRectHash', $key, $newObj);
}
return 1;
}
# Graphical operations - initial functions for drawing on the canvas
sub doDraw {
# Can be called by anything
# Checks every parchment object (GA::Obj::Parchment), each of which stores objects to be
# drawn in its ->markedRoomHash, ->markedRoomTagHash, ->markedRoomGuildHash,
# ->markedExitHash, ->markedExitTag Hash and ->markedLabelHash IVs
# Draws all of those objects, one region at a time
# Before calling this function, code should call $self->markObjs to add items to the hashes
# above
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' if there is no current regionmap (so nothing can be drawn), if
# $self->delayDrawFlag is set or if no objects have been marked for drawing
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$drawCount,
@parchmentList,
%parchmentHash,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doDraw', @_);
}
# If there is already a drawing cycle in progress (i.e. another call to this function), or
# if there's a drag operation in progress, do nothing
if ($self->delayDrawFlag || $self->dragFlag) {
# Force another call to $self->doDraw on the next call to ->winUpdate, to complete
# whatever drawing operations the calling function wanted
$self->ivPoke('winUpdateForceFlag', TRUE);
return undef;
} else {
# One call to this function represents a single drawing cycle. Once a cycle starts, it
# must not be interrupted by another call to this function.
$self->ivPoke('delayDrawFlag', TRUE);
}
# If the tooltips are visible, hide them
$self->hideTooltips();
# Do a quick count of the number of rooms and labels to be drawn, which gives us a rough
# approximation of how much drawing needs to be done
$drawCount = 0;
foreach my $parchmentObj ($self->ivValues('parchmentHash')) {
$drawCount += $parchmentObj->ivPairs('markedRoomHash') +
$parchmentObj->ivPairs('markedLabelHash');
}
# If this value is greater than the one specified by the world model IV (default: 500),
# make the pause window visible for the duration of the drawing cycle
if ($drawCount > $self->worldModelObj->drawPauseNum) {
$self->showPauseWin();
}
# Draw marked objects in each parchment, one at a time. If there's a current regionmap,
# draw that region first
%parchmentHash = $self->parchmentHash;
if ($self->currentParchment) {
delete $parchmentHash{$self->currentParchment->name};
push (@parchmentList, $self->currentParchment);
}
push (@parchmentList, values %parchmentHash);
OUTER: foreach my $parchmentObj (@parchmentList) {
my (
$regionmapObj, $roomCount, $exitCount, $index, $exitMode, $obscuredFlag,
$redrawFlag, $ornamentsFlag,
%markedRoomHash, %markedRoomTagHash, %markedRoomGuildHash, %markedExitHash,
%markedExitTagHash, %markedLabelHash,
);
# For large numbers of rooms, the algorithm in $self->doQuickDraw is quicker than the
# one in this function. If at least half the rooms and/or half the exits are marked
# to be drawn, just redraw the whole region
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $parchmentObj->name);
$roomCount = $regionmapObj->ivPairs('gridRoomHash');
$exitCount = $regionmapObj->ivPairs('gridExitHash');
if (
($roomCount > 100 && $parchmentObj->ivPairs('markedRoomHash') > ($roomCount / 2))
|| ($exitCount > 200 && $parchmentObj->ivPairs('markedExitHash') > ($exitCount / 2))
) {
# The TRUE flag means 'only redraw this region'
if ($self->redrawRegions($regionmapObj, TRUE)) {
# Redraw successful. If not, continue with this function's algorithm
next OUTER;
}
}
# Decide how exits are drawn. GA::Obj::WorldModel->drawExitMode is one of the values
# 'ask_regionmap', 'no_exit', 'simple_exit' and 'complex_exit'. The regionmap's
# ->drawExitMode is any of these values except 'ask_regionmap'
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $regionmapObj->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# Decide whether some exits should be obscured, or not
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$obscuredFlag = $regionmapObj->obscuredExitFlag;
} else {
$obscuredFlag = $self->worldModelObj->obscuredExitFlag;
}
# Decide whether unobscured rooms should be redrawn without their exits, when they
# are re-obscured (if not, the exits remain visible, which might be what the user
# wants)
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$redrawFlag = $regionmapObj->obscuredExitRedrawFlag;
} else {
$redrawFlag = $self->worldModelObj->obscuredExitRedrawFlag;
}
# Decide whether exit ornaments should be drawn, or not
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$ornamentsFlag = $regionmapObj->drawOrnamentsFlag;
} else {
$ornamentsFlag = $self->worldModelObj->drawOrnamentsFlag;
}
# If obscuring exits is enabled, compile a hash of rooms whose exits should be drawn -
# rooms near the current room, selected rooms (and any selected exits), and rooms
# whose room flags match those in GA::Client->constRoomNoObscuredHash (e.g.
# 'main_route')
# The TRUE argument means to mark any rooms which were previously unobscured, but which
# are now obscured, to be redrawn
$self->compileNoObscuredRooms($parchmentObj, $exitMode, $obscuredFlag, $redrawFlag);
$self->ivPoke('noObscuredRoomHash', $parchmentObj->noObscuredRoomHash);
$self->ivPoke('reObscuredRoomHash', $parchmentObj->reObscuredRoomHash);
# For speed, import the parchment object's hashes of objects marked to be drawn
# drawn
%markedRoomHash = $parchmentObj->markedRoomHash;
%markedRoomTagHash = $parchmentObj->markedRoomTagHash;
%markedRoomGuildHash = $parchmentObj->markedRoomGuildHash;
%markedExitHash = $parchmentObj->markedExitHash;
%markedExitTagHash = $parchmentObj->markedExitTagHash;
%markedLabelHash = $parchmentObj->markedLabelHash;
if (
! %markedRoomHash && ! %markedRoomTagHash && ! %markedRoomGuildHash
&& ! %markedExitHash && ! %markedExitTagHash && ! %markedLabelHash
) {
# Nothing to draw
next OUTER;
}
# Those hashes can now be emptied...
$parchmentObj->ivEmpty('markedRoomHash');
$parchmentObj->ivEmpty('markedRoomTagHash');
$parchmentObj->ivEmpty('markedRoomGuildHash');
$parchmentObj->ivEmpty('markedExitHash');
$parchmentObj->ivEmpty('markedExitTagHash');
$parchmentObj->ivEmpty('markedLabelHash');
# ...and if the parchment has no queued objects, it can be marked as fully drawn
if (
! $parchmentObj->queueRoomEchoHash && ! $parchmentObj->queueRoomBoxHash
&& ! $parchmentObj->queueRoomTextHash && ! $parchmentObj->queueRoomExitHash
&& ! $parchmentObj->queueRoomInfoHash && ! $parchmentObj->queueLabelHash
) {
$self->ivAdd('parchmentReadyHash', $parchmentObj->name, $parchmentObj);
$index = $self->ivFind('parchmentQueueList', $parchmentObj);
if (defined $index) {
$self->ivSplice('parchmentQueueList', $index, 1);
# Show the next region to be pre-drawn (if any) in the window's title bar
$self->setWinTitle();
}
}
# Set IV so that individual draw functions can quickly look up the regionmap and
# parchment objects being drawn
$self->ivPoke('drawParchment', $parchmentObj);
$self->ivPoke('drawRegionmap', $regionmapObj);
# And also the colours for that regionmap
$self->ivPoke('drawScheme', $self->worldModelObj->getRegionScheme($regionmapObj));
# Optimise the drawing process by doing many of the size and position calculations in
# advance
$self->prepareDraw($exitMode);
# Now we can do some drawing
# Draw rooms
foreach my $number (keys %markedRoomHash) {
my $roomObj = $markedRoomHash{$number};
$self->drawRoom($roomObj, $exitMode, $obscuredFlag, $ornamentsFlag);
# We don't need to draw the room tag and room guild (if any) for this room a second
# time, so we can delete the equivalent entries in those hashes
# ($self->drawCycleExitHash prevents us from drawing the same exit twice)
delete $markedRoomTagHash{number};
delete $markedRoomTagHash{number};
}
# Draw room tags
foreach my $roomObj (values %markedRoomTagHash) {
$self->drawRoomTag($roomObj);
}
# Draw room guilds
foreach my $roomObj (values %markedRoomGuildHash) {
$self->drawRoomGuild($roomObj);
}
# Draw exits and exit tags (except in mode 'no_exit')
if ($exitMode ne 'no_exit') {
foreach my $exitObj (values %markedExitHash) {
$self->drawExit($exitObj, $exitMode, $ornamentsFlag);
}
foreach my $exitObj (values %markedExitTagHash) {
$self->drawExitTag($exitObj);
}
}
# Draw labels
foreach my $labelObj (values %markedLabelHash) {
$self->drawLabel($labelObj);
}
}
# Make the pause window invisible
$self->hidePauseWin();
# Tidy up by resetting drawing cycle IVs
$self->tidyUpDraw();
$self->ivEmpty('drawCycleExitHash');
# Further calls to this function are now allowed
$self->ivPoke('delayDrawFlag', FALSE);
# Operation complete
return 1;
}
sub doQuickDraw {
# Called by $self->winUpdate to perform some pre-drawing operations, drawing a limited
# number of rooms, exits and/or labels on the map, several times a second
# Also called by $self->redrawRegions, because for drawing large number of rooms, the
# algorithm in this function is faster than the one in ->doDraw
#
# Expected arguments
# $parchmentObj - The parchment object (GA::Obj::Parchment) on which pre-draw operations
# are currently taking place
#
# Optional arguments
# $limitFlag - Set to TRUE if a limit can be placed on the number of rooms, exits
# and/or labels during a call to this function; the limit applied
# depends on the value of GA::Obj::WorldModel->preDrawAllocation. Set
# to FALSE (or 'undef') when no limit is required (i.e. when called by
# $self->redrawRegions)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $parchmentObj, $limitFlag, $check) = @_;
# Local variables
my (
$exitMode, $obscuredFlag, $ornamentsFlag, $checkTime, $stopFlag, $wmObj, $count,
$checkCount,
);
# Check for improper arguments
if (! defined $parchmentObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doQuickDraw', @_);
}
# If there is already a drawing cycle in progress (i.e. another call to this function or to
# $self->doDraw, do nothing)
if ($self->delayDrawFlag || $self->dragFlag) {
return undef;
} else {
# One a drawing cycle starts, it must not be interrupted by another call to this
# function, or to ->doDraw
$self->ivPoke('delayDrawFlag', TRUE);
}
# When pre-drawing, objects are drawn in stack order, from bottom to top; in very large
# maps (thousands of rooms), GooCanvas2 can complete the drawing much more quickly
# when everything can be raised to the top of the stack, rather than being
# arbitrarily inserted somewhere in the middle
# Tell individual drawing functions like $self->drawRoomBox, ->drawIncompleteExit (etc) to
# raise the canvas object to the top of the drawing stack every time
$self->ivPoke('quickDrawFlag', TRUE);
# Set IV so that individual draw functions can quickly look up the regionmap and parchment
# objects being drawn
$self->ivPoke('drawParchment', $parchmentObj);
$self->ivPoke(
'drawRegionmap',
$self->worldModelObj->ivShow('regionmapHash', $parchmentObj->name),
);
# And also the colours for that regionmap
$self->ivPoke('drawScheme', $self->worldModelObj->getRegionScheme($self->drawRegionmap));
# Decide how exits are drawn. GA::Obj::WorldModel->drawExitMode is one of the values
# 'ask_regionmap', 'no_exit', 'simple_exit' and 'complex_exit'. The regionmap's
# ->drawExitMode is any of these values except 'ask_regionmap'
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $self->drawRegionmap->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# Decide whether some exits should be obscured, or not
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$obscuredFlag = $self->drawRegionmap->obscuredExitFlag;
} else {
$obscuredFlag = $self->worldModelObj->obscuredExitFlag;
}
# Decide whether exit ornaments should be drawn, or not
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$ornamentsFlag = $self->drawRegionmap->drawOrnamentsFlag;
} else {
$ornamentsFlag = $self->worldModelObj->drawOrnamentsFlag;
}
# Set the time at which this function should stop drawing, and return control to the
# GA::Session (the next call to ->winUpdate will resume pre-drawing operations, if
# required)
# $self->winUpdate is called by GA::Session->maintainLoopDelay several times a second. Aim
# to spend only a proportion of the available processor time on pre-drawing operations
# (the percentage is GA::Obj::WorldModel->preDrawAllocation, a value in the range 1-100)
# Aim to spend no more than half the available time on pre-drawing operations
# If $limitFlag was not set, then there's no limit
if ($limitFlag) {
$checkTime = $axmud::CLIENT->getTime() + (
$self->session->maintainLoopDelay
* $self->worldModelObj->preDrawAllocation
/ 100
);
# We'll check that this time has passed after every 10 calls to ->drawRoom, ->drawLabel
# (etc)
$count = 0;
$checkCount = 10;
}
# Optimise the drawing process by doing many of the size and position calculations in
# advance
$self->prepareDraw($exitMode);
# Import the world model object (for speed)
$wmObj = $self->worldModelObj;
# Draw room echoes (position #2 in the canvas drawing stack)
if (! $stopFlag) {
OUTER: foreach my $roomObj ($parchmentObj->ivValues('queueRoomEchoHash')) {
# (Check the room still exists. This check, and the similar checks below, check for
# momentary inconsistencies while some other process takes place; code in the
# world model GA::Obj::WorldModel should update parchment objects automatically)
$parchmentObj->ivDelete('queueRoomEchoHash', $roomObj->number);
if (! $wmObj->ivExists('modelHash', $roomObj->number)) {
next OUTER;
}
# Don't draw this room at all if:
# 1. Its position on the map has not been set
# 2. The room isn't in the right region
if (
# (We'll assume that if ->xPosBlocks is set, so are ->yPosBlocks and
# ->zPosBlocks)
! defined $roomObj->xPosBlocks
|| $roomObj->parent != $self->drawRegionmap->number
) {
next OUTER;
}
# Draw the room echoes (if allowed)
if ($wmObj->drawRoomEchoFlag) {
$self->drawRoomEcho($roomObj, $exitMode, 1);
$self->drawRoomEcho($roomObj, $exitMode, -1);
$count++;
}
# Room boxes are higher in the drawing stack than room echoes
$parchmentObj->ivAdd('queueRoomBoxHash', $roomObj->number, $roomObj);
if (! $parchmentObj->queueRoomEchoHash) {
$self->updateSlaveInStack($parchmentObj, 2);
}
if ($checkTime && $count >= $checkCount) {
if ($checkTime < $axmud::CLIENT->getTime()) {
# We've used up the allotted time, so give up
$stopFlag = TRUE;
last OUTER;
} else {
# Check again after 10 more calls ->drawRoom, ->drawLabel (etc)
$count = 0;
}
}
}
}
# Draw room boxes (position #3 in the canvas drawing stack)
if (! $stopFlag) {
OUTER: foreach my $roomObj ($parchmentObj->ivValues('queueRoomBoxHash')) {
# (Check the room still exists)
$parchmentObj->ivDelete('queueRoomBoxHash', $roomObj->number);
if (! $wmObj->ivExists('modelHash', $roomObj->number)) {
next OUTER;
}
# Draw the room's border and interior
$self->drawRoomBox(
$exitMode,
$roomObj,
$self->borderCornerXPosPixels
+ ($roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels),
$self->borderCornerYPosPixels
+ ($roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels),
);
$count++;
# Room internal text is higher in the drawing stack than room boxes
$parchmentObj->ivAdd('queueRoomTextHash', $roomObj->number, $roomObj);
if (! $parchmentObj->queueRoomBoxHash) {
$self->updateSlaveInStack($parchmentObj, 3);
}
if ($checkTime && $count >= $checkCount) {
if ($checkTime < $axmud::CLIENT->getTime()) {
$stopFlag = TRUE;
last OUTER;
} else {
$count = 0;
}
}
}
}
# Draw room internal text (position #4 in the canvas drawing stack)
if (! $stopFlag) {
OUTER: foreach my $roomObj ($parchmentObj->ivValues('queueRoomTextHash')) {
my (
$canvasWidget, $xPos, $yPos, $unallocatedCount, $unallocatableCount,
$shadowCount, $regionCount, $superRegionCount,
);
# (Check the room still exists)
$parchmentObj->ivDelete('queueRoomTextHash', $roomObj->number);
if (! $wmObj->ivExists('modelHash', $roomObj->number)) {
next OUTER;
}
# Set the canvas widget and position of the room's gridblock (for speed)
$canvasWidget = $self->drawParchment->ivShow(
'canvasWidgetHash',
$roomObj->zPosBlocks,
);
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw room interior text (if allowed)
if ($wmObj->roomInteriorMode ne 'none') {
# Check each exit in the room, compiling various counts
$unallocatedCount = 0;
$unallocatableCount = 0;
$shadowCount = 0;
$regionCount = 0;
$superRegionCount = 0;
INNER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if ($exitObj) {
# Keep count of the total number of unallocated exits, and the number of
# unallocatable exits - we'll need the counts later in this function
if (
$exitObj->drawMode eq 'temp_alloc'
|| $exitObj->drawMode eq 'temp_unalloc'
) {
$unallocatedCount++;
if ($exitObj->drawMode eq 'temp_unalloc') {
$unallocatableCount++;
}
}
# Likewise, we keep count of the number of exits with shadow exits
if ($exitObj->shadowExit) {
$shadowCount++;
}
# And we also keep count of region/super region exits
if ($exitObj->superFlag) {
$superRegionCount++;
}
if ($exitObj->regionFlag) {
$regionCount++;
}
}
}
# Draw the room interior text
$self->drawRoomInteriorInfo(
$roomObj,
$canvasWidget,
$self->borderCornerXPosPixels
+ ($roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels),
$self->borderCornerYPosPixels
+ ($roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels),
$unallocatedCount,
$shadowCount,
$regionCount,
$superRegionCount,
);
$count++;
} else {
# (Unallocatable exits are always shown, so count them)
$unallocatableCount = 0;
INNER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if ($exitObj && $exitObj->drawMode eq 'temp_unalloc') {
$unallocatableCount++;
}
}
}
# If there are any unallocatable exits, the number is drawn in the bottom-centre of
# the room box
if ($unallocatableCount) {
$self->drawUnallocatableCount($roomObj, $canvasWidget, $unallocatableCount);
}
# Exits/exit ornaments/checked directions are higher in the drawing stack than room
# internal text
$parchmentObj->ivAdd('queueRoomExitHash', $roomObj->number, $roomObj);
if (! $parchmentObj->queueRoomTextHash) {
$self->updateSlaveInStack($parchmentObj, 4);
}
if ($checkTime && $count >= $checkCount) {
if ($checkTime < $axmud::CLIENT->getTime()) {
$stopFlag = TRUE;
last OUTER;
} else {
$count = 0;
}
}
}
}
# Draw exits, exit ornaments and checked directions (position #5 in the canvas drawing
# stack)
if (! $stopFlag) {
OUTER: foreach my $roomObj ($parchmentObj->ivValues('queueRoomExitHash')) {
my ($canvasWidget, $xPos, $yPos);
# (Check the room still exists, and that it is not obscured, meaning that its exits
# are not drawn)
$parchmentObj->ivDelete('queueRoomExitHash', $roomObj->number);
if (
! $wmObj->ivExists('modelHash', $roomObj->number)
|| (
$obscuredFlag && ! $self->ivExists('noObscuredRoomHash', $roomObj->number)
)
) {
next OUTER;
}
# Set the canvas widget (for speed)
$canvasWidget = $self->drawParchment->ivShow(
'canvasWidgetHash',
$roomObj->zPosBlocks,
);
# Draw exits and exit ornaments
if ($roomObj->exitNumHash) {
INNER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if ($exitObj) {
# Draw the exit. In $exitMode 'no_exit', we only draw exits whose
# ->mapDir is 'up' or 'down'
if (
$exitMode ne 'no_exit'
|| (
$exitObj->mapDir
&& ($exitObj->mapDir eq 'up' || $exitObj->mapDir eq 'down')
)
) {
$self->drawExit(
$exitObj,
$exitMode,
$ornamentsFlag,
$canvasWidget,
$roomObj,
);
}
}
}
}
# Draw checked directions (if allowed)
if ($self->worldModelObj->drawCheckedDirsFlag && $exitMode ne 'no_exit') {
my @newObjList;
foreach my $dir ($roomObj->ivKeys('checkedDirHash')) {
my $canvasObj = $self->drawCheckedDir($roomObj, $canvasWidget, $dir);
if ($canvasObj) {
push (@newObjList, $canvasObj);
}
}
if (@newObjList) {
$self->drawParchment->addDrawnCheckedDir($roomObj, \@newObjList);
}
}
# (Whether or not any exits/checked directions were drawn, count this as a single
# drawing operation)
$count++;
# Room tags, room guilds and exit tags are higher in the drawing stack than exits
$parchmentObj->ivAdd('queueRoomInfoHash', $roomObj->number, $roomObj);
if (! $parchmentObj->queueRoomTextHash) {
$self->updateSlaveInStack($parchmentObj, 5);
}
if ($checkTime && $count >= $checkCount) {
if ($checkTime < $axmud::CLIENT->getTime()) {
$stopFlag = TRUE;
last OUTER;
} else {
$count = 0;
}
}
}
}
# Draw room tags, room guilds and exit tags (position #6 in the canvas drawing stack)
if (! $stopFlag) {
OUTER: foreach my $roomObj ($parchmentObj->ivValues('queueRoomInfoHash')) {
my $canvasWidget;
# (Check the room still exists)
$parchmentObj->ivDelete('queueRoomInfoHash', $roomObj->number);
if (! $wmObj->ivExists('modelHash', $roomObj->number)) {
next OUTER;
}
# Set the canvas widget (for speed)
$canvasWidget = $self->drawParchment->ivShow(
'canvasWidgetHash',
$roomObj->zPosBlocks,
);
# Draw the room tag, if there is one
if ($roomObj->roomTag) {
# Draw the room tag
$self->drawRoomTag(
$roomObj,
$canvasWidget,
($roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels),
($roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels),
);
}
# Draw the room guild, if there is one
if ($roomObj->roomGuild) {
# Draw the room guild
$self->drawRoomGuild(
$roomObj,
$canvasWidget,
($roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels),
($roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels),
);
}
# Draw exit tags, if there are any
if ($roomObj->exitNumHash) {
OUTER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if ($exitObj) {
# Draw the exit tag, if any, but not in mode 'no_exit'
if ($exitMode ne 'no_exit' && $exitObj->exitTag) {
$self->drawExitTag(
$exitObj,
$canvasWidget,
$roomObj,
);
}
}
}
}
# (Whether or not any room tags/room guilds/exit tags were drawn, count this as a
# single drawing operation)
$count++;
if (! $parchmentObj->queueRoomInfoHash) {
$self->updateSlaveInStack($parchmentObj, 6);
}
if ($checkTime && $count >= $checkCount) {
if ($checkTime < $axmud::CLIENT->getTime()) {
$stopFlag = TRUE;
last OUTER;
} else {
$count = 0;
}
}
}
}
# Draw labels (position #7 in the canvas drawing stack)
if (! $stopFlag) {
OUTER: foreach my $labelObj ($parchmentObj->ivValues('queueLabelHash')) {
$parchmentObj->ivDelete('queueLabelHash', $labelObj->number);
# Draw the label
$self->drawLabel($labelObj);
$count++;
if (! $parchmentObj->queueLabelHash) {
$self->updateSlaveInStack($parchmentObj, 7);
}
if ($checkTime && $count >= $checkCount) {
if ($checkTime < $axmud::CLIENT->getTime()) {
$stopFlag = TRUE;
last OUTER;
} else {
$count = 0;
}
}
}
}
# Tidy up by resetting drawing cycle IVs
$self->tidyUpDraw();
# The next drawing cycle can insert canvas objects at arbitrary positions in the canvas
# drawing stack
$self->ivPoke('quickDrawFlag', FALSE);
# Further calls to this function and to $self->doDraw are now allowed
$self->ivPoke('delayDrawFlag', FALSE);
# Return control to the calling function, having drawn some (or possibly all) of the
# rooms, exits and/or labels waiting to be drawn
return 1;
}
sub updateSlaveInStack {
# Called by $self->doQuickDraw
# Canvas objects are arranged in a stack (so that labels are drawn above rooms). So that we
# can quickly position new canvas objects in that stick, we use a small number of
# invisible canvas objects. This function is called after (for example) all room boxes
# have been drawn, or all exits have been drawn, to move one of the invisible canvas
# objects to their correct stack position, which at the time of calling is at the top of
# the stack
#
# Expected arguments
# $parchmentObj - The parchment object (GA::Obj::Parchment) on which pre-draw operations
# are currently taking place
# $posn - The relative position of the invisible canvas objects, a value in the
# range 0-7 (defined in the comments for GA::Obj::Parchment->new)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $parchmentObj, $posn, $check) = @_;
# Check for improper arguments
if (! defined $parchmentObj || ! defined $posn || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->updateSlaveInStack', @_);
}
foreach my $levelObj ($parchmentObj->ivValues('levelHash')) {
my $slaveObj = $levelObj->ivIndex('slaveCanvasObjList', $posn);
if ($slaveObj) {
$slaveObj->raise();
}
}
return 1;
}
sub prepareDraw {
# During a drawing cycle, called by $self->doDraw/->doQuickDraw for each region in which
# canvas objects will be drawn (also called, outside of a drawing cycle, by
# $self->startDrag)
# Optimises the drawing process by doing many of the size and position calculations in
# advance
#
# Expected arguments
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'no_exit', 'simple_exit' or 'complex_exit'
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $exitMode, $check) = @_;
# Check for improper arguments
if (! defined $exitMode || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->prepareDraw', @_);
}
# Decide on the size of the area in which room interior text is drawn - half the width of a
# room, less some extra pixels so the text doesn't touch the edge of the room
if ($exitMode eq 'no_exit') {
$self->ivPoke('drawRoomTextWidth', $self->drawRegionmap->blockWidthPixels);
$self->ivPoke('drawRoomTextHeight', $self->drawRegionmap->blockHeightPixels);
} else {
$self->ivPoke('drawRoomTextWidth', $self->drawRegionmap->roomWidthPixels);
$self->ivPoke('drawRoomTextHeight', $self->drawRegionmap->roomHeightPixels);
}
# Decide on the size of room interior text. The value is based on the size of the room, by
# default; the value can be increased (or decreased) by the text size ratios stored in the
# world model
$self->ivPoke('drawRoomTextSize', (($self->drawRoomTextWidth - 3) / 2));
# Decide on the size of text drawn for labels, room tags, room guilds and exit tags. The
# value is the size of text used by room tags, by default; the value can be increased (or
# (decreased) by the text size ratios stored in the world model
$self->ivPoke('drawOtherTextSize', (($self->drawRegionmap->roomWidthPixels - 3) / 2));
# Work out the position of each kind of exit in the sixteen cardinal directions, as if they
# were to be drawn at the top-left gridblock
$self->preDrawPositions($exitMode);
$self->preDrawExits($exitMode);
# Quickly compile a hash of (custom) primary directions that should be counted, if
# $self->worldModelObj->roomInteriorMode is set to 'checked_count'
# Store it as $self->preCountCheckedHash (or empty that hash, if appropriate)
$self->prepareCheckedCounts();
return 1;
}
sub compileNoObscuredRooms {
# Called by $self->preparePreDraw, ->redrawRegions and ->doDraw for each parchment object
# (GA::Obj::Parchment) for which canvas objects will be drawn
# If obscuring exits is enabled, compile a hash of rooms whose exits should be drawn - rooms
# near the current room, selected rooms (and any selected exits), and rooms whose room
# flags match those in GA::Client->constRoomNoObscuredHash (e.g. 'main_route')
# The hash is stored in the specified parchment object's ->noObscuredRoomHash IV, from which
# the calling code can retrieve it
#
# Optionally compares the new contents of a parchment object's ->noObscuredRoomHash with its
# previous contents (generated by the previous call to this function). Any rooms that were
# added to the hash in the previous call, but not in this call, can be marked to be
# redrawn (e.g. when GA::Obj::WorldModel->obscuredExitRedrawFlag is set)
#
# Expected arguments
# $parchmentObj - The GA::Obj::Parchment currently being drawn
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'no_exit', 'simple_exit' or
# 'complex_exit'
# $obscuredFlag - Matches the ->obscuredExitFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
# $redrawFlag - TRUE if items which, at the end of this function are no longer in
# GA::Obj::Parchment->noObscuredRoomHash should be marked to be
# redrawn; FALSE otherwise
#
# Optional arguments
# $quickFlag - TRUE if drawing is to be done via successive calls to
# $self->doQuickDraw; FALSE if this function has been called
# directly by $self->doDraw
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $parchmentObj, $exitMode, $obscuredFlag, $redrawFlag, $quickFlag, $check) = @_;
# Local variables
my (
$wmObj, $regionmapObj, $currentRoomObj, $radius,
%roomHash, %removedHash,
);
# Check for improper arguments
if (
! defined $parchmentObj || ! defined $exitMode || ! defined $obscuredFlag
|| ! defined $redrawFlag || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->compileNoObscuredRooms', @_);
}
# Import some IVs (for convenience)
$wmObj = $self->worldModelObj;
$regionmapObj = $wmObj->ivShow('regionmapHash', $parchmentObj->name);
$currentRoomObj = $self->mapObj->currentRoom;
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$radius = $regionmapObj->obscuredExitRadius;
} else {
$radius = $wmObj->obscuredExitRadius;
}
# If the flag is disabled, or if no exits are being drawn at all, then obscured exits are
# not required
if ($obscuredFlag && $exitMode ne 'no_exit') {
# If there is a current room, and if that room is in the regionmap being drawn by the
# calling function, add it to the hash
if ($currentRoomObj && $currentRoomObj->parent == $regionmapObj->number) {
# If the specified obscuration radius is greater than one, add any rooms near the
# current room (and on the same level), including the current room itself
if ($radius > 1) {
for (
my $x = ($currentRoomObj->xPosBlocks - $radius + 1);
$x <= ($currentRoomObj->xPosBlocks + $radius - 1);
$x++
) {
for (
my $y = ($currentRoomObj->yPosBlocks - $radius + 1);
$y <= ($currentRoomObj->yPosBlocks + $radius - 1);
$y++
) {
my ($key, $otherRoomNum);
# The regionmap stores rooms in a hash, using a key in form 'x_y_z'
$key = $x . '_' . $y . '_' . $currentRoomObj->zPosBlocks;
if ($regionmapObj->ivExists('gridRoomHash', $key)) {
$otherRoomNum = $regionmapObj->ivShow('gridRoomHash', $key);
$roomHash{$otherRoomNum} = undef;
# This room should also be marked to be drawn, if it is not already
# (otherwise, when a new current room is set, exits for the
# surrounding rooms aren't drawn)
if (! $quickFlag) {
$parchmentObj->ivAdd(
'markedRoomHash',
$otherRoomNum,
$self->worldModelObj->ivShow(
'modelHash',
$otherRoomNum,
),
);
}
}
}
}
}
}
# Add any selected rooms (and, for any selected exits, the parent rooms)
if ($self->selectedRoom) {
$roomHash{$self->selectedRoom->number} = undef;
} else {
foreach my $selectedRoomNum ($self->ivKeys('selectedRoomHash')) {
$roomHash{$selectedRoomNum} = undef;
}
}
if ($self->selectedExit) {
$roomHash{$self->selectedExit->parent} = undef;
} else {
foreach my $selectedExitObj ($self->ivValues('selectedExitHash')) {
$roomHash{$selectedExitObj->parent} = undef;
}
}
# Examine rooms that are due to be drawn. Any which have one of the room flags specified
# by GA::Client->constRoomNoObscuredHash can be drawn with its exits
if (! $quickFlag) {
# We only need to check rooms marked to be drawn
OUTER: foreach my $otherRoomObj ($parchmentObj->ivValues('markedRoomHash')) {
foreach my $roomFlag ($otherRoomObj->ivKeys('roomFlagHash')) {
if ($axmud::CLIENT->ivExists('constRoomNoObscuredHash', $roomFlag)) {
$roomHash{$otherRoomObj->number} = undef;
next OUTER;
}
}
}
} else {
# A whole region is marked to be redrawn, so need to check every room inside it
OUTER: foreach my $otherRoomNum ($regionmapObj->ivValues('gridRoomHash')) {
my $otherRoomObj = $wmObj->ivShow('modelHash', $otherRoomNum);
foreach my $roomFlag ($otherRoomObj->ivKeys('roomFlagHash')) {
if ($axmud::CLIENT->ivExists('constRoomNoObscuredHash', $roomFlag)) {
$roomHash{$otherRoomObj->number} = undef;
next OUTER;
}
}
}
}
}
# All done. Rooms which were in GA::Obj::Parchment->noObscuredRoomHash, but which are about
# to be removed (because they're not in %roomHash), can be marked to be redrawn without
# exits
if ($redrawFlag) {
OUTER: foreach my $otherRoomNum ($parchmentObj->ivKeys('noObscuredRoomHash')) {
if (! exists $roomHash{$otherRoomNum}) {
my $roomObj = $wmObj->ivShow('modelHash', $otherRoomNum);
# Check the room isn't selected, and doesn't have one of the room flags
# specified by GA::Client->constRoomNoObscuredHash
if (
($self->selectedRoom && $self->selectedRoom eq $roomObj)
|| $self->ivExists('selectedRoomHash', $roomObj->number)
) {
next OUTER;
}
foreach my $key ($roomObj->roomFlagHash) {
if ($axmud::CLIENT->ivExists('constRoomNoObscuredHash', $key)) {
next OUTER;
}
}
# This room can be marked to be redrawn
$parchmentObj->ivAdd('markedRoomHash', $otherRoomNum, $roomObj);
# We'll also add this room to an IV, so that the room's exit canvas objects can
# be destroyed when GA::Win::Map->drawRoom is called
$removedHash{$otherRoomNum} = undef;
}
}
}
# Now update the IVs, which can be retrieved by the calling code
$parchmentObj->ivPoke('noObscuredRoomHash', %roomHash);
$parchmentObj->ivPoke('reObscuredRoomHash', %removedHash);
return 1;
}
sub tidyUpDraw {
# Called by $self->doDraw/->doQuickDraw at the end of a drawing cycle (also called, outside
# of a drawing cycle, by $self->stopDrag). Also called by $self->winReset
# Resets all drawing cycle IVs
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->tidyUpDraw', @_);
}
# (NB $self->drawCycleExitHash is emptied, when appropriate, by other functions)
$self->ivUndef('drawRegionmap');
$self->ivUndef('drawParchment');
$self->ivUndef('drawScheme');
$self->ivUndef('drawRoomTextSize');
$self->ivUndef('drawRoomTextWidth');
$self->ivUndef('drawRoomTextHeight');
$self->ivUndef('drawOtherTextSize');
$self->ivUndef('blockCornerXPosPixels');
$self->ivUndef('blockCornerYPosPixels');
$self->ivUndef('blockCentreXPosPixels');
$self->ivUndef('blockCentreYPosPixels');
$self->ivUndef('borderCornerXPosPixels');
$self->ivUndef('borderCornerYPosPixels');
$self->ivEmpty('preDrawnIncompleteExitHash');
$self->ivEmpty('preDrawnUncertainExitHash');
$self->ivEmpty('preDrawnLongExitHash');
$self->ivEmpty('preDrawnSquareExitHash');
$self->ivEmpty('preCountCheckedHash');
return 1;
}
sub preDrawPositions {
# Called by $self->prepareDraw for each region in which canvas objects will be drawn
# Works out the coordinates of the
# - top-left corner of the gridblock
# - centre of the gridblock (and of the room)
# - top-left corner of the room border
# ...relative to the gridblock, and stores the values as IVs. This cuts down on the time it
# takes to draw objects in the gridblock
#
# Expected arguments
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'no_exit', 'simple_exit' or 'complex_exit'
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $exitMode, $check) = @_;
# Local variables
my (
$blockCentreXPosPixels, $blockCentreYPosPixels, $borderCornerXPosPixels,
$borderCornerYPosPixels,
);
# Check for improper arguments
if (! defined $exitMode || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->preDrawPositions', @_);
}
# Find the coordinates of the pixel occupying the centre of the block (and of the room)
($blockCentreXPosPixels, $blockCentreYPosPixels) = $self->getBlockCentre(
0, # $roomObj->xPosBlocks,
0, # $roomObj->yPosBlocks,
0, # $blockCornerXPosPixels,
0, # $blockCornerYPosPixels,
$self->drawRegionmap,
);
# Find the coordinates of the pixel at the top-left corner of the room's border
if ($exitMode eq 'no_exit') {
# Draw exit mode 'no_exit': The room takes up the whole gridblock
($borderCornerXPosPixels, $borderCornerYPosPixels) = (0, 0);
} else {
# Draw exit modes 'simple_exit'/'complex_exit': The room takes up the central part of
# the gridblock
($borderCornerXPosPixels, $borderCornerYPosPixels) = $self->getBorderCorner(
0, # $roomObj->xPosBlocks,
0, # $roomObj->yPosBlocks,
0, # $blockCornerXPosPixels,
0, # $blockCornerYPosPixels,
$self->drawRegionmap,
);
}
# Store them as IVs
$self->ivPoke('blockCornerXPosPixels', 0);
$self->ivPoke('blockCornerYPosPixels', 0);
$self->ivPoke('blockCentreXPosPixels', $blockCentreXPosPixels);
$self->ivPoke('blockCentreYPosPixels', $blockCentreYPosPixels);
$self->ivPoke('borderCornerXPosPixels', $borderCornerXPosPixels);
$self->ivPoke('borderCornerYPosPixels', $borderCornerYPosPixels);
return 1;
}
sub preDrawExits {
# Called by $self->prepareDraw for each region in which canvas objects will be drawn
# Works out the position of each kind of exit relative to its gridblock, and stores the
# values as IVs. This cuts down on the time it takes to draw objects in the gridblock
#
# Expected arguments
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'no_exit', 'simple_exit' or 'complex_exit'
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $exitMode, $check) = @_;
# Local variables
my (
%vectorHash, %oppDirHash, %uncertainExitHash, %incompleteExitHash,
%longExitHash, %squareExitHash,
);
# Check for improper arguments
if (! defined $exitMode || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->preDrawExits', @_);
}
# Import $self->constVectorHash, in the form
# north => [0, -1, 0],
# northnortheast => [0.5, -1, 0],
# northeast => [1, -1, 0],
# eastnortheast => [1, -0.5, 0],
# east => [1, 0, 0],
# eastsoutheast => [1, 0.5, 0],
# southeast => [1, 1, 0],
# southsoutheast => [0.5, 1, 0],
# south => [0, 1, 0],
# southsouthwest => [-0.5, 1, 0],
# southwest => [-1, 1, 0],
# westsouthwest => [-1, 0.5, 0],
# west => [-1, 0, 0],
# westnorthwest => [-1, -0.5, 0],
# northwest => [-1, -1, 0],
# northnorthwest => [-0.5, -1, 0],
# up => [0, 0, 1],
# down => [0, 0, -1],
%vectorHash = $self->constVectorHash;
# Remove 'up' and 'down' - we don't need to calculate the positions of those exits
delete $vectorHash{'up'};
delete $vectorHash{'down'};
# Import the GA::Client's list of standard primary directions and their standard opposite
# directions, in the form
# north => 'south',
# northnortheast => 'southsouthwest',
# northeast => 'southwest',
# eastnortheast => 'westsouthwest',
# east => 'west',
# eastsoutheast => 'westnorthwest',
# southeast => 'northwest',
# southsoutheast => 'northnorthwest',
# south => 'north',
# southsouthwest => 'northnortheast',
# southwest => 'northeast',
# westsouthwest => 'eastnortheast',
# west => 'east',
# westnorthwest => 'eastsoutheast',
# northwest => 'southeast',
# northnorthwest => 'southsoutheast',
# up => 'down',
# down => 'up',
%oppDirHash = $axmud::CLIENT->constOppDirHash;
# Remove 'up' and 'down' - we don't need to calculate the positions of those exits
delete $oppDirHash{'up'};
delete $oppDirHash{'down'};
# Pre-draw incomplete exits
foreach my $key (keys %vectorHash) {
my (
$vectorRef, $exitStartXPosPixels, $exitStartYPosPixels, $blockEdgeXPosPixels,
$blockEdgeYPosPixels,
);
# Get the key's corresponding value
$vectorRef = $vectorHash{$key};
# Find the coordinates of the pixel at the edge of the room, just outside the border,
# from which a cardinal exit (one using the eight compass directions) starts
($exitStartXPosPixels, $exitStartYPosPixels) = $self->getExitStart(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->borderCornerXPosPixels,
$self->borderCornerYPosPixels,
$self->drawRegionmap,
);
if ($exitMode eq 'complex_exit') {
# Complex exits - find the coordinates of the pixel near (but not at) the edge of
# the gridblock, which is intersected by the cardinal exit
($blockEdgeXPosPixels, $blockEdgeYPosPixels) = $self->getNearBlockEdge(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->drawRegionmap,
);
} else {
# Simple exits - find the coordinates of the pixel at the edge of the gridblock,
# which is intersected by the cardinal exit
($blockEdgeXPosPixels, $blockEdgeYPosPixels) = $self->getBlockEdge(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->drawRegionmap,
);
}
# Store the coordinates as a list reference
$incompleteExitHash{$key} = [
$exitStartXPosPixels,
$exitStartYPosPixels,
$blockEdgeXPosPixels,
$blockEdgeYPosPixels,
];
}
# Pre-draw uncertain exits (drawn the same way, regardless of the value of $exitMode)
foreach my $key (keys %vectorHash) {
my (
$vectorRef, $exitStartXPosPixels, $exitStartYPosPixels, $blockEdgeXPosPixels,
$blockEdgeYPosPixels,
);
# Get the key's corresponding value
$vectorRef = $vectorHash{$key};
# Find the coordinates of the pixel at the edge of the room, just outside the border,
# from which a cardinal exit starts
($exitStartXPosPixels, $exitStartYPosPixels) = $self->getExitStart(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->borderCornerXPosPixels,
$self->borderCornerYPosPixels,
$self->drawRegionmap,
);
# Find the coordinates of the pixel at the edge of the gridblock, which is intersected
# by the cardinal exit
($blockEdgeXPosPixels, $blockEdgeYPosPixels) = $self->getBlockEdge(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->drawRegionmap,
);
# Store the coordinates as a list reference
$uncertainExitHash{$key} = [
$exitStartXPosPixels,
$exitStartYPosPixels,
$blockEdgeXPosPixels,
$blockEdgeYPosPixels,
];
}
# Pre-draw long exits (used by 1-way and 2-way exits; drawn the same way, regardless of the
# value of $exitMode)
foreach my $key (keys %vectorHash) {
my (
$vectorRef, $oppCardinalDir, $oppVectorRef, $exitStartXPosPixels,
$exitStartYPosPixels, $blockEdgeXPosPixels, $blockEdgeYPosPixels,
$exitStopXPosPixels, $exitStopYPosPixels,
);
# Get the key's corresponding value
$vectorRef = $vectorHash{$key};
# Get the opposite cardinal direction (e.g. 'north' > 'south')
$oppCardinalDir = $oppDirHash{$key};
# Get the exit's vector from the centre of the arrival room (should be equal and
# opposite to $vectorRef)
$oppVectorRef = $vectorHash{$oppCardinalDir};
# Find the coordinates of the pixel at the edge of the room, just outside the border,
# from which a cardinal exit starts
($exitStartXPosPixels, $exitStartYPosPixels) = $self->getExitStart(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->borderCornerXPosPixels,
$self->borderCornerYPosPixels,
$self->drawRegionmap,
);
# Find the coordinates of the pixel at the edge of the gridblock, which is intersected
# by the cardinal exit
($blockEdgeXPosPixels, $blockEdgeYPosPixels) = $self->getBlockEdge(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->drawRegionmap,
);
# Find the coordinates of the pixel at the edge of the destination room, just outside
# the border, from which a cardinal exit stops
($exitStopXPosPixels, $exitStopYPosPixels) = $self->getExitStart(
0,
0,
$oppVectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->borderCornerXPosPixels,
$self->borderCornerYPosPixels,
$self->drawRegionmap,
);
# Store the coordinates as a list reference
$longExitHash{$key} = [
$exitStartXPosPixels,
$exitStartYPosPixels,
$blockEdgeXPosPixels,
$blockEdgeYPosPixels,
$exitStopXPosPixels,
$exitStopYPosPixels,
];
}
# Pre-draw square exits (used by unallocated, impassable, broken and region exits; drawn the
# same way, regardless of the value of $exitMode)
foreach my $key (keys %vectorHash) {
my (
$vectorRef, $exitStartXPosPixels, $exitStartYPosPixels, $blockEdgeXPosPixels,
$blockEdgeYPosPixels, $squareStartXPosPixels, $squareStartYPosPixels,
$squareStopXPosPixels, $squareStopYPosPixels, $halfHorizontalLength,
$halfVerticalLength,
);
# Get the key's corresponding value
$vectorRef = $vectorHash{$key};
# Find the coordinates of the pixel at the edge of the room, just outside the border,
# from which a cardinal exit starts
($exitStartXPosPixels, $exitStartYPosPixels) = $self->getExitStart(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->borderCornerXPosPixels,
$self->borderCornerYPosPixels,
$self->drawRegionmap,
);
# Find the coordinates of the pixel near (but not at) the edge of the gridblock, which
# is intersected by the cardinal exit
($blockEdgeXPosPixels, $blockEdgeYPosPixels) = $self->getNearBlockEdge(
0,
0,
$vectorRef,
$self->blockCentreXPosPixels,
$self->blockCentreYPosPixels,
$self->drawRegionmap,
);
# Adjust the coordinates of the two pixels at either end of the exit, so that it's
# easier to draw '+' exits (and so that '+' are the same size as 'x')
# The line (or the square for which the ends of the line are in opposite corners) must
# have an odd-numbered length, so that the '+' and 'x' are symmetrical
if (
$exitStartXPosPixels != $blockEdgeXPosPixels
&& int(($blockEdgeXPosPixels - $exitStartXPosPixels) / 2)
!= (($blockEdgeXPosPixels - $exitStartXPosPixels) / 2)
) {
# Adjust the end of the line, to make it slightly bigger
$blockEdgeXPosPixels += $$vectorRef[0];
}
if (
$exitStartYPosPixels != $blockEdgeYPosPixels
&& int(($blockEdgeYPosPixels - $exitStartYPosPixels) / 2)
!= (($blockEdgeYPosPixels - $exitStartYPosPixels) / 2)
) {
# Adjust the end of the line, to make it slightly bigger
$blockEdgeYPosPixels += $$vectorRef[1];
}
# Adjust the coordinates so that the exit's start is below and to the left of the
# block's edge, by reversing coordinates where necessary
if ($exitStartXPosPixels > $blockEdgeXPosPixels) {
($exitStartXPosPixels, $blockEdgeXPosPixels)
= ($blockEdgeXPosPixels, $exitStartXPosPixels);
}
if ($exitStartYPosPixels < $blockEdgeYPosPixels) {
($exitStartYPosPixels, $blockEdgeYPosPixels)
= ($blockEdgeYPosPixels, $exitStartYPosPixels);
}
# North/east/south/west
if (
$exitStartXPosPixels == $blockEdgeXPosPixels
|| $exitStartYPosPixels == $blockEdgeYPosPixels
) {
# North/south
if ($exitStartXPosPixels == $blockEdgeXPosPixels) {
# Get half the length of the exit
$halfHorizontalLength = abs(
int(($blockEdgeYPosPixels - $exitStartYPosPixels) / 2),
);
# Find the coordinates of the one corner of the square occupied by the 'x'
$squareStartXPosPixels = $exitStartXPosPixels - $halfHorizontalLength;
$squareStartYPosPixels = $exitStartYPosPixels;
# Find the coordinates of the opposite corner of the square
$squareStopXPosPixels = $blockEdgeXPosPixels + $halfHorizontalLength;
$squareStopYPosPixels = $blockEdgeYPosPixels;
# East/west
} else {
# Get half the length of the exit
$halfVerticalLength = abs(
int(($blockEdgeXPosPixels - $exitStartXPosPixels) / 2),
);
# Find the coordinates of the one corner of the square occupied by the 'x'
$squareStartXPosPixels = $exitStartXPosPixels;
$squareStartYPosPixels = $exitStartYPosPixels + $halfVerticalLength;
# Find the coordinates of the opposite corner of the square
$squareStopXPosPixels = $blockEdgeXPosPixels;
$squareStopYPosPixels = $blockEdgeYPosPixels - $halfVerticalLength;
}
# Store the coordinates as a list reference
$squareExitHash{$key} = [
$squareStartXPosPixels,
$squareStartYPosPixels,
$squareStopXPosPixels,
$squareStopYPosPixels,
];
} else {
# We already have the coordinates of opposite ends of a square
$squareExitHash{$key} = [
$exitStartXPosPixels,
$exitStartYPosPixels,
$blockEdgeXPosPixels,
$blockEdgeYPosPixels,
];
}
}
# Store the accumulated data
$self->ivPoke('preDrawnIncompleteExitHash', %incompleteExitHash);
$self->ivPoke('preDrawnUncertainExitHash', %uncertainExitHash);
$self->ivPoke('preDrawnLongExitHash', %longExitHash);
$self->ivPoke('preDrawnSquareExitHash', %squareExitHash);
return 1;
}
sub prepareCheckedCounts {
# Called by $self->prepareDraw for each region in which canvas objects will be drawn
# Compiles a hash of custom primary directions which should be counted, if
# $self->worldModelObj->roomInteriorMode is set to 'checked_count'. If not, just empties
# the existing hash
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->prepareCheckedCounts', @_);
}
if ($self->worldModelObj->roomInteriorMode ne 'checked_count') {
# Don't need to count checked and checkable directions at all
$self->ivEmpty('preCountCheckedHash');
} else {
$self->ivPoke(
'preCountCheckedHash',
$self->worldModelObj->getCheckableDirs($self->session),
);
}
return 1;
}
# Graphical operations - drawing canvas objects
sub drawRoom {
# Called by $self->doDraw or $self->startDrag
# Draws (or redraws) a single room on the grid, in the gridblock specified by the room's
# ->xPosBlocks, ->yPosBlocks and ->zPosBlocks IVs
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room to draw
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'no_exit', 'simple_exit' or
# 'complex_exit'
# $obscuredFlag - Matches the ->obscuredExitFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
# $ornamentsFlag - Matches the ->drawOrnamentsFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
#
# Optional arguments
# $dragFlag - Set to TRUE when called by $self->startDrag in which case we don't
# draw extra markings like interior text or an emphasised border
#
# Return values
# 'undef' on improper arguments or if the room can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitMode, $obscuredFlag, $ornamentsFlag, $dragFlag, $check) = @_;
# Local variables
my (
$canvasWidget, $interiorMode, $xPos, $yPos, $unallocatedCount, $unallocatableCount,
$shadowCount, $regionCount, $superRegionCount, $checkedCount, $roomTagCanvasObj,
);
# Check for improper arguments
if (
! defined $roomObj || ! defined $exitMode || ! defined $obscuredFlag
|| ! defined $ornamentsFlag || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRoom', @_);
}
# Don't draw this room if:
# 1. Its position on the map has not been set
# 2. The room isn't in the right region
if (
# (We'll assume that if ->xPosBlocks is set, so are ->yPosBlocks and ->zPosBlocks)
! defined $roomObj->xPosBlocks
|| $roomObj->parent != $self->drawRegionmap->number
) {
return undef;
}
# If the parchment object doesn't have a canvas widget for this room's level, create one
if (! $self->drawParchment->ivExists('canvasWidgetHash', $roomObj->zPosBlocks)) {
$self->createMap($self->drawRegionmap, $self->drawParchment, $roomObj->zPosBlocks);
}
$canvasWidget = $self->drawParchment->ivShow('canvasWidgetHash', $roomObj->zPosBlocks);
# Get the interior text mode (e.g. 'none'), for speed
$interiorMode = $self->worldModelObj->roomInteriorMode;
# Before drawing the canvas objects that make up this room, destroy any existing canvas
# objects from the last time the room was drawn
$self->deleteCanvasObj('room', $roomObj, $self->drawRegionmap, $self->drawParchment);
# Also destroy the canvas objects for any checked directions
$self->deleteCanvasObj('checked_dir', $roomObj, $self->drawRegionmap, $self->drawParchment);
# For any rooms that were unobscured, and have been marked to be redrawn because they are
# now re-obscured, we need to destroy the canvas objects for its exits
if ($self->ivExists('reObscuredRoomHash', $roomObj->number)) {
foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if ($exitObj) {
$self->deleteCanvasObj(
'exit',
$exitObj,
$self->drawRegionmap,
$self->drawParchment,
);
}
}
}
# Draw a room echo on the level immediately below and above the room's level (if allowed)
if (! $dragFlag && $self->worldModelObj->drawRoomEchoFlag) {
$self->drawRoomEcho($roomObj, $exitMode, 1);
$self->drawRoomEcho($roomObj, $exitMode, -1);
}
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw the room's border and interior
$self->drawRoomBox(
$exitMode,
$roomObj,
$self->borderCornerXPosPixels + $xPos,
$self->borderCornerYPosPixels + $yPos,
$canvasWidget,
$dragFlag,
);
# Check each exit, compiling various counts. If we're allowed to, draw the exits, too
if (
$roomObj->exitNumHash
&& (! $obscuredFlag || $self->ivExists('noObscuredRoomHash', $roomObj->number))
) {
$unallocatedCount = 0;
$unallocatableCount = 0;
$shadowCount = 0;
$regionCount = 0;
$superRegionCount = 0;
OUTER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if ($exitObj) {
# Keep count of the total number of unallocated exits, and the number of
# unallocatable exits - we'll need the counts later in this function
if ($interiorMode ne 'none') {
if (
$exitObj->drawMode eq 'temp_alloc'
|| $exitObj->drawMode eq 'temp_unalloc'
) {
$unallocatedCount++;
if ($exitObj->drawMode eq 'temp_unalloc') {
$unallocatableCount++;
}
}
# Likewise, we keep count of the number of exits with shadow exits
if ($exitObj->shadowExit) {
$shadowCount++;
}
# And we also keep count of region/super region exits
if ($exitObj->superFlag) {
$superRegionCount++;
}
if ($exitObj->regionFlag) {
$regionCount++;
}
}
# Draw the exit. In $exitMode 'no_exit', we only draw exits whose ->mapDir is
# 'up' or 'down'
if (
$exitMode ne 'no_exit'
|| (
$exitObj->mapDir
&& ($exitObj->mapDir eq 'up' || $exitObj->mapDir eq 'down')
)
) {
$self->drawExit(
$exitObj,
$exitMode,
$ornamentsFlag,
$canvasWidget,
$roomObj,
);
}
# Draw the exit tag, if any, but not in mode 'no_exit'
if ($exitMode ne 'no_exit' && $exitObj->exitTag) {
$self->drawExitTag(
$exitObj,
$canvasWidget,
$roomObj,
);
}
}
}
# Also draw checked directions, if allowed
if ($self->worldModelObj->drawCheckedDirsFlag && $exitMode ne 'no_exit') {
my @newObjList;
foreach my $dir ($roomObj->ivKeys('checkedDirHash')) {
my $canvasObj = $self->drawCheckedDir($roomObj, $canvasWidget, $dir);
if ($canvasObj) {
push (@newObjList, $canvasObj);
}
}
if (@newObjList) {
# Checked directions can't be clicked, so we can store all checked directions
# for the room in a single entry in the hash
# (Also, there is no event handler for the canvas object(s) - clicking a checked
# direction does nothing)
$self->drawParchment->addDrawnCheckedDir($roomObj, \@newObjList);
}
}
}
if (! $dragFlag) {
# Draw information displayed in the room's interior. If ->roomInteriorMode is set to
# 'shadow_count', $unallocatedCount and $shadowCount are displayed; otherwise, these
# values are ignored and some other values are displayed
if ($interiorMode ne 'none') {
$self->drawRoomInteriorInfo(
$roomObj,
$canvasWidget,
$self->borderCornerXPosPixels + $xPos,
$self->borderCornerYPosPixels + $yPos,
$unallocatedCount,
$shadowCount,
$regionCount,
$superRegionCount,
);
}
# If there are any unallocatable exits, the number is drawn in the bottom-centre of the
# room box
if ($unallocatableCount) {
$self->drawUnallocatableCount($roomObj, $canvasWidget, $unallocatableCount);
}
}
# Draw the room tag, if there is one
if ($roomObj->roomTag) {
# Draw the room tag
$self->drawRoomTag(
$roomObj,
$canvasWidget,
$xPos,
$yPos,
);
}
# Draw the room guild, if there is one
if ($roomObj->roomGuild) {
# Draw the room guild
$self->drawRoomGuild(
$roomObj,
$canvasWidget,
$xPos,
$yPos,
);
}
return 1;
}
sub drawExit {
# Called by $self->doDraw/->doQuickDraw or $self->drawRoom
# Draws a single exit (and its exit tag, if necessary)
#
# Expected arguments
# $exitObj - Blessed reference of the GA::Obj::Exit to draw
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'no_exit', 'simple_exit' or
# 'complex_exit'
# $ornamentsFlag - Matches the ->drawOrnamentsFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
#
# Optional arguments
# $canvasWidget, $roomObj
# - Set when called by $self->drawRoom; the canvas widget (GooCanvas2::Canvas)
# on which the room is drawn and the parent room itself. If not set, this
# function fetches them
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $exitObj, $exitMode, $ornamentsFlag, $canvasWidget, $roomObj, $check) = @_;
# Local variables
my $twinExitObj;
# Check for improper arguments
if (
! defined $exitObj || ! defined $exitMode || ! defined $ornamentsFlag || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawExit', @_);
}
# Set the canvas widget on which the room is drawn, if not already set
if (! $canvasWidget) {
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
$canvasWidget = $self->drawParchment->ivShow('canvasWidgetHash', $roomObj->zPosBlocks);
}
# Get the twin exit, if there is one
if ($exitObj->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow('exitModelHash', $exitObj->twinExit);
}
# Don't draw this exit if:
# 1. It has already been drawn during this drawing cycle (initiated by $self->doDraw)
# 2. The exit doesn't have a parent room
# 3. It has a twin exit which has already been drawn - unless it's a region or normal
# (un-bent) broken exit, in which case we must draw both the exit and its twin during
# a drawing cycle, and unless it's an up/down exit, in which case we must draw it,
# in case the twin exit (which might already have been drawn) is in the 'east'
# direction, or something
# 4. The exit has a shadow exit (e.g. 'enter cave' which leads to the same room as the
# exit 'west'; only the exit 'west' should be drawn)
if (
$self->ivExists('drawCycleExitHash', $exitObj->number)
|| ! $roomObj
|| (
$twinExitObj
&& $self->ivExists('drawCycleExitHash', $twinExitObj->number)
&& $exitObj->mapDir ne 'up'
&& $exitObj->mapDir ne 'down'
&& (
! $exitObj->brokenFlag
|| $exitObj->bentFlag
) && ! $exitObj->regionFlag
) || $exitObj->shadowExit
) {
return undef;
}
# Before drawing the canvas objects that make up this exit, destroy any existing canvas
# objects from the last time the exit was drawn
$self->deleteCanvasObj('exit', $exitObj, $self->drawRegionmap, $self->drawParchment);
# The canvas objects for the exit may have been drawn associated with $exitObj, or with its
# twin exit (if any); make sure those canvas objects are destroyed, too (except for
# normal broken exits, region exits, impassable exits and mystery exits)
if (
$twinExitObj
&& (
(! $twinExitObj->brokenFlag || $twinExitObj->bentFlag)
&& ! $twinExitObj->regionFlag
&& $twinExitObj->exitOrnament ne 'impass'
&& $twinExitObj->exitOrnament ne 'mystery'
)
) {
# (Twin's region might not be the same, so let ->deleteCanvasObj fetch it)
$self->deleteCanvasObj('exit', $twinExitObj);
}
# Draw the exit
if (
(
$exitObj->exitOrnament eq 'impass'
|| $exitObj->exitOrnament eq 'mystery'
|| (
$twinExitObj
&& (
$twinExitObj->exitOrnament eq 'impass'
|| $twinExitObj->exitOrnament eq 'mystery'
)
)
) && $ornamentsFlag
) {
# It's an impassable or mystery exit. The impassable/mystery ornament and the exit are
# drawn together by this one function
$self->drawImpassableExit($roomObj, $exitObj, $canvasWidget, $twinExitObj);
} elsif ($exitObj->brokenFlag) {
# It's a broken exit
if ($exitObj->bentFlag) {
$self->drawBentExit(
$roomObj,
$exitObj,
$exitMode,
$ornamentsFlag,
$twinExitObj,
$canvasWidget,
);
} else {
$self->drawBrokenExit($roomObj, $exitObj, $canvasWidget);
}
} elsif ($exitObj->regionFlag) {
# It's a region exit
$self->drawRegionExit($roomObj, $exitObj, $canvasWidget);
} elsif ($exitObj->drawMode eq 'temp_alloc') {
# It's an unallocated exit, temporarily allocated to a primary direction
# NB Unallocated exits, not temporarily allocated to a primary direction because none
# are available (->drawMode is 'temp_unalloc') are dealth with by ->drawRoom
$self->drawUnallocatedExit($roomObj, $exitObj, $canvasWidget);
} elsif ($exitObj->destRoom) {
if ($exitObj->twinExit) {
# If it's a two-way exit (we can come back in the opposite direction)
$self->drawTwoWayExit($roomObj, $exitObj, $exitMode, $ornamentsFlag, $canvasWidget);
} elsif ($exitObj->retraceFlag) {
# It's a retracing exit (leading back to the same room)
$self->drawRetracingExit($roomObj, $exitObj, $canvasWidget);
} elsif ($exitObj->oneWayFlag) {
# It's a one-way exit
$self->drawOneWayExit($roomObj, $exitObj, $ornamentsFlag, $canvasWidget);
} elsif ($exitObj->randomType ne 'none') {
# It's a random exit (leading to a random room)
$self->drawRandomExit($roomObj, $exitObj, $canvasWidget);
} else {
# It's an uncertain exit - we know we can go 'north' from A to B, but we don't yet
# know if we can go 'south' from B to A
$self->drawUncertainExit($roomObj, $exitObj, $ornamentsFlag, $canvasWidget);
}
} elsif ($exitObj->randomType ne 'none') {
# It's a random exit (leads to a random location)
$self->drawRandomExit($roomObj, $exitObj, $canvasWidget);
} else {
# We don't know where this exit is going. Draw an incomplete exit (almost to
# the edge of the room's gridblock)
$self->drawIncompleteExit($roomObj, $exitObj, $ornamentsFlag, $canvasWidget);
}
# Record the fact that we've drawn this exit, so that we don't draw it (or its twin) again
# during the current drawing cycle
# Exceptions: draw both and exit and its twin if they are broken or regions exits, but do
# draw both if the twin's map direction is 'up' or 'down'
$self->ivAdd('drawCycleExitHash', $exitObj->number, undef);
if (
$twinExitObj
&& $twinExitObj->mapDir ne 'up'
&& $twinExitObj->mapDir ne 'down'
&& (! $twinExitObj->brokenFlag || $exitObj->bentFlag)
&& ! $twinExitObj->regionFlag
) {
$self->ivAdd('drawCycleExitHash', $twinExitObj->number, undef);
# Delete the twin's canvas object (if it has one), so that $exitObj isn't drawn on
# top of its twin exit
# (Twin's region might not be the same, so let ->deleteCanvasObj fetch it)
$self->deleteCanvasObj('exit', $twinExitObj);
}
# Also update the regionmap's hash of drawn exits
$self->drawRegionmap->storeExit($exitObj);
# Draw the exit tag, if any, but not in mode 'no_exit'
if ($exitMode ne 'no_exit' && $exitObj->exitTag) {
$self->drawExitTag($exitObj, $canvasWidget, $roomObj);
}
return 1;
}
sub drawRoomTag {
# Called by $self->doDraw/->doQuickDraw or $self->drawRoom
# Draws (or redraws) a room tag, close to the room itself
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room whose tag is being drawn
#
# Optional arguments
# $canvasWidget - Set when called by $self->drawRoom; the canvas widget
# (GooCanvas2::Canvas) on which the room is drawn. If not set, this
# function fetches it
# $blockCornerXPosPixels, $blockCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's
# gridblock. If not set, this function fetches them
#
# Return values
# 'undef' on improper arguments or if the room tag can't be drawn
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $blockCornerXPosPixels, $blockCornerYPosPixels, $check,
) = @_;
# Local variables
my ($posnListRef, $text, $textSize, $newObj, $levelObj);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRoomTag', @_);
}
# Set the canvas widget on which the room is drawn, if not already set
if (! $canvasWidget) {
$canvasWidget = $self->drawParchment->ivShow('canvasWidgetHash', $roomObj->zPosBlocks);
}
# Don't draw this room tag if:
# 1. The room's position on the map has not been set
# 2. The room isn't in the right region
# 3. The room doesn't have a room tag set
# 4. Room tags are drawn as interior text, inside the room box
if (
# (We'll assume that if ->xPosBlocks is set, so are ->yPosBlocks and ->zPosBlocks)
! defined $roomObj->xPosBlocks
|| $roomObj->parent != $self->drawRegionmap->number
|| ! $roomObj->roomTag
|| $self->worldModelObj->roomInteriorMode eq 'room_tag'
) {
return undef;
}
# Before drawing the canvas objects that make up this room tag, destroy any existing canvas
# objects from the last time the room tag was drawn
$self->deleteCanvasObj('room_tag', $roomObj, $self->drawRegionmap, $self->drawParchment);
# Get the coordinates of the room's gridblock, if they weren't specified by the calling
# function
if (! defined $blockCornerXPosPixels) {
# Find the coordinates of the pixel occupying the top-left corner of the block
($blockCornerXPosPixels, $blockCornerYPosPixels) = $self->getBlockCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$self->drawRegionmap,
);
}
# The room tag is drawn above where the 'north' exit would be drawn, immediately above the
# room. Find the hypothetical exit's position
$posnListRef = $self->ivShow('preDrawnLongExitHash', 'north');
# Set capitalisation
if ($self->worldModelObj->capitalisedRoomTagFlag) {
# Room tags displayed in caps
$text = uc($roomObj->roomTag);
} else {
# Not displayed in caps
$text = $roomObj->roomTag;
}
# Set the text size
$textSize = int($self->drawOtherTextSize * $self->worldModelObj->roomTagRatio);
# Draw the canvas object
$newObj = GooCanvas2::CanvasText->new(
'parent' => $canvasWidget->get_root_item(),
'anchor' => 'center',
'x' => ($blockCornerXPosPixels + $$posnListRef[2] + $roomObj->roomTagXOffset),
'y' => ($blockCornerYPosPixels + $$posnListRef[3] + $roomObj->roomTagYOffset),
'font' => $self->worldModelObj->mapFont . ' ' . $textSize,
# 'use-markup' => FALSE,
'text' => $text,
'width' => -1,
'fill-color' => $self->getRoomTagColour($roomObj),
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 6));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('room_tag', $newObj, $roomObj);
# Store the canvas object
$self->drawParchment->addDrawnRoomTag($roomObj, [$newObj]);
return 1;
}
sub drawRoomGuild {
# Called by $self->doDraw/->doQuickDraw or $self->drawRoom
# Draws (or redraws) a room guild, close to the room itself
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room whose tag is being drawn
#
# Optional arguments
# $canvasWidget - Set when called by $self->drawRoom; the the canvas widget
# (GooCanvas2::Canvas) on which the room is drawn. If not set, this
# function fetches it
# $blockCornerXPosPixels, $blockCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's
# gridblock. If not set, this function fetches them
#
# Return values
# 'undef' on improper arguments or if the room guild can't be drawn
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $blockCornerXPosPixels, $blockCornerYPosPixels, $check,
) = @_;
# Local variables
my ($posnListRef, $textSize, $newObj, $levelObj);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRoomGuild', @_);
}
# Set the canvas widget on which the room is drawn, if not already set
if (! $canvasWidget) {
$canvasWidget = $self->drawParchment->ivShow('canvasWidgetHash', $roomObj->zPosBlocks);
}
# Don't draw this room guild if:
# 1. The room's position on the map has not been set
# 2. The room isn't in the right region
# 3. The room doesn't have a room guild set
if (
# (We'll assume that if ->xPosBlocks is set, so are ->yPosBlocks and ->zPosBlocks)
! defined $roomObj->xPosBlocks
|| $roomObj->parent != $self->drawRegionmap->number
|| ! $roomObj->roomGuild
) {
return undef;
}
# Before drawing the canvas objects that make up this room guild, destroy any existing
# canvas objects from the last time the room guild was drawn
$self->deleteCanvasObj('room_guild', $roomObj, $self->drawRegionmap, $self->drawParchment);
# Get the coordinates of the room's gridblock, if they weren't specified by the calling
# function
if (! defined $blockCornerXPosPixels) {
# Find the coordinates of the pixel occupying the top-left corner of the block
($blockCornerXPosPixels, $blockCornerYPosPixels) = $self->getBlockCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$self->drawRegionmap,
);
}
# The room guild is drawn above where the 'south' exit would be drawn, immediately below the
# room. Find the hypothetical exit's position
$posnListRef = $self->ivShow('preDrawnLongExitHash', 'south');
# Set the text size
$textSize = int($self->drawOtherTextSize * $self->worldModelObj->roomGuildRatio);
# Draw the canvas object
$newObj = GooCanvas2::CanvasText->new(
'parent' => $canvasWidget->get_root_item(),
'anchor' => 'center',
'x' => ($blockCornerXPosPixels + $$posnListRef[2] + $roomObj->roomGuildXOffset),
'y' => ($blockCornerYPosPixels + $$posnListRef[3] + $roomObj->roomGuildYOffset),
'font' => $self->worldModelObj->mapFont . ' ' . $textSize,
# 'use-markup' => FALSE,
'text' => $roomObj->roomGuild,
'width' => -1,
'fill-color' => $self->getRoomGuildColour($roomObj),
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 6));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('room_guild', $newObj, $roomObj);
# Store the canvas object
$self->drawParchment->addDrawnRoomGuild($roomObj, [$newObj]);
return 1;
}
sub drawExitTag {
# Called by $self->doDraw/->doQuickDraw, ->drawRoom and ->drawExit
# Draws (or redraws) an exit tag, close to the exit itself
#
# Expected arguments
# $exitObj - Blessed reference of the GA::Obj::Exit to draw
#
# Optional arguments
# $canvasWidget, $roomObj
# - Set when called by $self->drawRoom/->drawExit; the canvas widget
# (GooCanvas2::Canvas) on which the room is drawn and the parent room
# itself. If not set, this function fetches them
#
# Return values
# 'undef' on improper arguments or if the room tag can't be drawn
# 1 otherwise
my ($self, $exitObj, $canvasWidget, $roomObj, $check) = @_;
# Local variables
my ($posnListRef, $colour, $textSize, $xPos, $yPos, $newObj, $levelObj);
# Check for improper arguments
if (! defined $exitObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawExitTag', @_);
}
# Set the canvas widget on which the room is drawn, if not already set
if (! $canvasWidget) {
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
$canvasWidget = $self->drawParchment->ivShow('canvasWidgetHash', $roomObj->zPosBlocks);
}
# Don't draw this exit tag if:
# 1. The exit has a shadow exit (e.g. 'enter cave' which leads to the same room as the
# exit 'west'; only the exit 'west' should be drawn)
# 2. The exit hasn't been allocated a primary direction (stored in ->mapDir)
# 3. The exit doesn't have an exit tag set
if (
$exitObj->shadowExit
|| ! $exitObj->mapDir
|| ! $exitObj->exitTag
) {
return undef;
}
# Before drawing the canvas objects that make up this exit tag, destroy any existing canvas
# objects from the last time the exit tag was drawn
$self->deleteCanvasObj('exit_tag', $exitObj, $self->drawRegionmap, $self->drawParchment);
# Find the exit's position, if it had been drawn as an uncertain exit. For exits drawn as
# up/down, draw the exit tag as if it were at the north/south exit, by default
if ($exitObj->mapDir eq 'up') {
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', 'north');
} elsif ($exitObj->mapDir eq 'down') {
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', 'south');
} else {
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $exitObj->mapDir);
}
# Decide which colour to use
$colour = $self->getExitTagColour($exitObj);
# Set the text size
$textSize = int($self->drawOtherTextSize * $self->worldModelObj->exitTagRatio);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw the canvas object
$newObj = GooCanvas2::CanvasText->new(
'parent' => $canvasWidget->get_root_item(),
# e.g. 'GOO_CANVAS_ANCHOR_S'
'anchor' => $self->ivShow('constGtkAnchorHash', $exitObj->mapDir),
'x' => ($$posnListRef[2] + $xPos + $exitObj->exitTagXOffset),
'y' => ($$posnListRef[3] + $yPos + $exitObj->exitTagYOffset),
'font' => $self->worldModelObj->mapFont . ' ' . $textSize,
# 'use-markup' => FALSE,
'text' => $exitObj->exitTag,
'width' => -1,
'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 6));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit_tag', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExitTag($roomObj, $exitObj, [$newObj]);
return 1;
}
sub drawLabel {
# Called by $self->doDraw/->doQuickDraw
# Draws (or redraws) a map label
#
# Expected arguments
# $labelObj - The GA::Obj::MapLabel being drawn
#
# Return values
# 'undef' on improper arguments or if the label can't be drawn
# 1 otherwise
my ($self, $labelObj, $check) = @_;
# Local variables
my (
$canvasWidget, $styleObj, $useObj, $colour, $markup, $text, $textSize, $newObj,
$boundsObj, $newObj2,
@newObjList,
);
# Check for improper arguments
if (! defined $labelObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawLabel', @_);
}
# Don't draw this room tag if:
# 1. The label's position on the map has not been set
# 2. The label isn't in the right region
# 3. The label doesn't contain any text
if (
# (We'll assume that if ->xPosBlocks is set, so are ->yPosBlocks and ->zPosBlocks)
! defined $labelObj->xPosPixels
|| $labelObj->region ne $self->drawRegionmap->name
|| ! defined $labelObj->name
|| $labelObj->name eq ''
) {
return undef;
}
# If the parchment object doesn't have a canvas widget for this label's level, create one
if (! $self->drawParchment->ivExists('canvasWidgetHash', $labelObj->level)) {
$self->createMap($self->drawRegionmap, $self->drawParchment, $labelObj->level);
}
$canvasWidget = $self->drawParchment->ivShow('canvasWidgetHash', $labelObj->level);
# Before drawing the canvas objects that make up this label, destroy any existing canvas
# objects from the last time the label was drawn
$self->deleteCanvasObj('label', $labelObj, $self->drawRegionmap, $self->drawParchment);
# Set the colour and style
if (defined $labelObj->style) {
$styleObj = $self->worldModelObj->ivShow('mapLabelStyleHash', $labelObj->style);
}
if ($styleObj) {
$useObj = $styleObj; # Set style from the style object
} else {
$useObj = $labelObj; # Set style from the map label object's own IVs
}
# When selected, a box with an underlay colour does not change colour, but a box with no
# underlay colour does change, matching the selected colour of the text
if (
($self->selectedLabel && $self->selectedLabel eq $labelObj)
|| $self->ivExists('selectedLabelHash', $labelObj->id)
) {
$colour = $self->drawScheme->selectMapLabelColour;
} else {
$colour = $useObj->textColour;
}
if ($colour) {
$markup = 'foreground="' . $colour . '"';
}
# If ->boxFlag is TRUE, we use the box's fill colour as the underlay
if ($useObj->underlayColour && ! $useObj->boxFlag) {
if (! $markup) {
$markup = 'background="' . $useObj->underlayColour . '"';
} else {
$markup .= ' background="' . $useObj->underlayColour . '"';
}
}
if ($markup) {
$text = $labelObj->name;
# Pango will complain about certain characters, so replace them with an entity
$text =~ s/\&/&/g;
$text =~ s/\</</g;
$text =~ s/\>/>/g;
$markup = '<span ' . $markup . '>' . $text . '</span>';
}
if ($useObj->italicsFlag) {
$markup = '<i>' . $markup . '</i>';
}
if ($useObj->boldFlag) {
$markup = '<b>' . $markup . '</b>';
}
if ($useObj->underlineFlag) {
$markup = '<u>' . $markup . '</u>';
}
if ($useObj->strikeFlag) {
$markup = '<s>' . $markup . '</s>';
}
# Set the text size
$textSize = int(
$self->drawOtherTextSize * $self->worldModelObj->labelRatio * $useObj->relSize
);
# Draw the canvas object
$newObj = GooCanvas2::CanvasText->new(
'parent' => $canvasWidget->get_root_item(),
'anchor' => 'GOO_CANVAS_ANCHOR_W', # Draw text to the right of the original mouse click
'x' => $labelObj->xPosPixels,
'y' => $labelObj->yPosPixels,
'font' => $self->worldModelObj->mapFont . ' ' . $textSize,
'use-markup' => TRUE,
'text' => $markup,
'width' => -1,
# 'fill-color' => '#000000',
);
push (@newObjList, $newObj);
# Rotate the label, if required
if ($useObj->rotateAngle) {
$newObj->rotate($useObj->rotateAngle, $labelObj->xPosPixels, $labelObj->yPosPixels);
}
# Get the bounds of the space used by the label (a GooCanvas2::CanvasBounds objects)
$boundsObj = $newObj->get_bounds();
# Draw a box at the same position, if required
if ($useObj->boxFlag) {
if (! $useObj->underlayColour) {
$newObj2 = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $boundsObj->x1 - 10,
'y' => $boundsObj->y1 - 10,
'width' => $boundsObj->x2 - $boundsObj->x1 + 20,
'height' => $boundsObj->y2 - $boundsObj->y1 + 20,
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
} else {
# Use the fill colour as the text's underlay colour, so everything inside the box
# border is coloured
$newObj2 = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $boundsObj->x1 - 10,
'y' => $boundsObj->y1 - 10,
'width' => $boundsObj->x2 - $boundsObj->x1 + 20,
'height' => $boundsObj->y2 - $boundsObj->y1 + 20,
# 'line-width' => 2,
'stroke-color' => '#000000',
'fill-color' => $useObj->underlayColour,
);
}
push (@newObjList, $newObj2);
}
# Set the object(s) positions in the canvas drawing stack, putting the box (if drawn) below
# the text
foreach my $canvasObj (reverse @newObjList) {
$canvasObj->raise();
}
# Set up the event handler for the canvas object (only for the text - not the box)
$self->setupCanvasObjEvent('label', $newObj, $labelObj);
if ($newObj2) {
$self->setupCanvasObjEvent('label', $newObj2, $labelObj);
}
# Store the canvas object(s)
$self->drawParchment->addDrawnLabel($labelObj, \@newObjList);
return 1;
}
# Graphical operations - drawing canvas objects, supplementary functions
sub drawRoomBox {
# Called by $self->drawRoom->doQuickDraw to draw the room box in two colours - a border,
# and an interior (and some graffiti, if this room has been tagged with graffiti)
#
# Expected arguments
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'no_exit', 'simple_exit' or 'complex_exit'
# $roomObj - Blessed reference of the GA::ModelObj::Room being drawn
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
#
# Optional arguments
# $canvasWidget
# - Set when called by $self->drawRoom; the canvas widget (GooCanvas2::Canvas)
# on which the room box is drawn. If not set, this function fetches it
# $dragFlag - Set to TRUE when called by $self->drawRoom was itself called by
# $self->startDrag, in which case we don't draw extra markings like
# interior text or an emphasised border
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my (
$self, $exitMode, $roomObj, $borderCornerXPosPixels, $borderCornerYPosPixels,
$canvasWidget, $dragFlag, $check,
) = @_;
# Local variables
my (
$roomWidth, $roomHeight, $borderColour, $currentMode, $roomColour, $borderSize,
$levelObj, $newObj, $origColour, $newObj2, $fillColour, $xSize, $ySize, $newObj3,
$strokeColour, $newObj4, $slaveObj,
@objList,
);
# Check for improper arguments
if (
! defined $exitMode || ! defined $roomObj || ! defined $borderCornerXPosPixels
|| ! defined $borderCornerYPosPixels || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRoomBox', @_);
}
# Set the canvas widget on which the room is drawn, if not already set
if (! $canvasWidget) {
$canvasWidget = $self->drawParchment->ivShow('canvasWidgetHash', $roomObj->zPosBlocks);
}
# In draw exit mode 'no_exit' (draw no exits), the room takes up the whole gridblock
if ($exitMode eq 'no_exit') {
$roomWidth = $self->drawRegionmap->blockWidthPixels;
$roomHeight = $self->drawRegionmap->blockWidthPixels;
# In draw exit mode 'simple_exit'/'complex_exit', the room takes up the middle part of the
# gridblock
} else {
$roomWidth = $self->drawRegionmap->roomWidthPixels;
$roomHeight = $self->drawRegionmap->roomHeightPixels;
}
# Get the border colour. If $roomObj is the current, last known or ghost room, $currentMode
# is set to the current value of GA::Obj::WorldModel->currentRoomMode; for all other
# rooms it is set to 'single'
($borderColour, $currentMode) = $self->getBorderColour($roomObj);
# Get the interior colour
if ($currentMode eq 'interior') {
# (Instead of changing the border colour, fill in the room interior)
$roomColour = $borderColour;
$borderColour = $self->drawScheme->borderColour;
} else {
$roomColour = $self->getRoomColour($roomObj);
}
# Set the room box's border width
if (! $dragFlag && $currentMode eq 'double') {
$borderSize = 4;
} else {
$borderSize = 2;
}
# Need to adjust the canvas objects' stack positions, later in the function
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
# Draw the canvas object for the room box itself
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $borderCornerXPosPixels + ($borderSize / 2) - 1,
'y' => $borderCornerYPosPixels + ($borderSize / 2) - 1,
'width' => $roomWidth - $borderSize + 1,
'height' => $roomHeight - $borderSize + 1,
'line-width' => $borderSize,
'stroke-color' => $borderColour,
'fill-color' => $roomColour,
);
push (@objList, $newObj);
if (! $dragFlag) {
# Grafitti and wilderness markings don't change colour along with the room border
$origColour = $self->drawScheme->borderColour;
# If the room has been tagged with graffiti, draw a big X
if ($self->graffitiModeFlag && $self->ivExists('graffitiHash', $roomObj->number)) {
$newObj2 = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($borderCornerXPosPixels + 1)
. ' ' . ($borderCornerYPosPixels + 1)
. ' L ' . ($borderCornerXPosPixels + $roomWidth - 1)
. ' ' . ($borderCornerYPosPixels + $roomHeight - 1)
. ' M ' . ($borderCornerXPosPixels + $roomWidth - 1)
. ' ' . ($borderCornerYPosPixels + 1)
. ' L ' . ($borderCornerXPosPixels + 1)
. ' ' . ($borderCornerYPosPixels + $roomHeight - 1),
# 'line-width' => 2,
'stroke-color' => $origColour,
# 'fill-color' => $origColour,
);
push (@objList, $newObj2);
}
# If it's a wilderness room, mark it as one
if ($roomObj->wildMode ne 'normal') {
if ($roomObj->wildMode eq 'wild') {
$fillColour = $origColour; # Filled-in circle
} else {
$fillColour = $roomColour; # Empty circle
}
# Don't draw a circle of zero size/width
$xSize = int($roomWidth / 10);
$ySize = int($roomHeight / 10); # One side of centre
if ($xSize && $ySize) {
$newObj3 = GooCanvas2::CanvasEllipse->new(
'parent' => $canvasWidget->get_root_item(),
# center-x and center-y are fractional numbers, to get the position right
'center-x' => $borderCornerXPosPixels + ($roomWidth / 2),
'center-y' => $borderCornerYPosPixels + ($roomHeight / 2) + $ySize,
'radius_x' => $xSize,
'radius_y' => $ySize,
'stroke-color' => $origColour,
'fill-color' => $fillColour,
);
push (@objList, $newObj3);
}
}
# If it's a new current room which matches existing world model rooms, mark it as one
if (
$self->mapObj->currentMatchFlag
&& $self->mapObj->currentRoom
&& $self->mapObj->currentRoom eq $roomObj
) {
# Don't draw a square of zero size/width
$xSize = int($roomWidth / 10);
$ySize = int($roomHeight / 10);
if ($xSize && $ySize) {
# For 1 matching room, draw a (default) black square. For multiple matching
# rooms, draw a (default) red square
if ($self->mapObj->ivNumber('currentMatchList') == 1) {
$strokeColour = $origColour;
} else {
$strokeColour = $self->drawScheme->currentBorderColour;
}
$newObj4 = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $borderCornerXPosPixels + ($roomWidth / 2) - $xSize,
'y' => $borderCornerYPosPixels + ($roomHeight / 2),
'width' => ($xSize * 2),
'height' => ($ySize * 2),
# 'line-width' => 2,
'stroke-color' => $strokeColour,
# 'fill-color' => $strokeColour,
);
push (@objList, $newObj4);
}
}
}
# Set the canvas objects' positions in the canvas drawing stack, and set up event handlers
# for each canvas object
if ($self->quickDrawFlag) {
if ($newObj3) {
$newObj3->raise();
$self->setupCanvasObjEvent('room', $newObj3, $roomObj);
}
if ($newObj4) {
$newObj4->raise();
$self->setupCanvasObjEvent('room', $newObj4, $roomObj);
}
if ($newObj2) {
$newObj2->raise();
$self->setupCanvasObjEvent('room', $newObj2, $roomObj);
}
$newObj->raise();
$self->setupCanvasObjEvent('room', $newObj, $roomObj);
} else {
$slaveObj = $levelObj->ivIndex('slaveCanvasObjList', 3);
$newObj->lower($slaveObj);
$self->setupCanvasObjEvent('room', $newObj, $roomObj);
if ($newObj2) {
$newObj2->lower($slaveObj);
$self->setupCanvasObjEvent('room', $newObj2, $roomObj);
}
if ($newObj4) {
$newObj4->lower($slaveObj);
$self->setupCanvasObjEvent('room', $newObj4, $roomObj);
}
if ($newObj3) {
$newObj3->lower($slaveObj);
$self->setupCanvasObjEvent('room', $newObj3, $roomObj);
}
}
# Store the canvas object(s)
$self->drawParchment->addDrawnRoom($roomObj, \@objList);
return 1;
}
sub drawFakeRoomBox {
# Called by $self->startDrag
# Draws a fake room on the grid, at the gridblock occupied by the specified room which is
# involved in a drag operation
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room that's about to be dragged
#
# Return values
# 'undef' on improper arguments or if the fake room can't be drawn
# Otherwise, returns the GooCanvas2::CanvasRect drawn
my ($self, $roomObj, $check) = @_;
# Local variables
my ($canvasWidget, $exitMode, $roomWidth, $roomHeight, $newObj, $levelObj);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawFakeRoomBox', @_);
}
# Don't draw this fake room if:
# 1. The dragged room's position on the map has not been set
# 2. The dragged room isn't on the currently-displayed level
# 3. The dragged room is not in the currently-displayed region
if (
# (We'll assume that if ->xPosBlocks is set, so are ->yPosBlocks and ->zPosBlocks)
! defined $roomObj->xPosBlocks
|| $roomObj->zPosBlocks != $self->currentRegionmap->currentLevel
|| $roomObj->parent != $self->currentRegionmap->number
) {
return undef;
}
# Get the canvas widget for the current level
$canvasWidget = $self->currentParchment->ivShow('canvasWidgetHash', $roomObj->zPosBlocks);
# Get the draw exit mode in operation, which determines the size of the rooms drawn
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $self->currentRegionmap->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# In draw exit mode 'no_exit' (draw no exits), the room takes up the whole gridblock
if ($exitMode eq 'no_exit') {
$roomWidth = $self->drawRegionmap->blockWidthPixels;
$roomHeight = $self->drawRegionmap->blockWidthPixels;
# In draw exit mode 'simple_exit'/'complex_exit', the room takes up the middle part of the
# gridblock
} else {
$roomWidth = $self->drawRegionmap->roomWidthPixels;
$roomHeight = $self->drawRegionmap->roomHeightPixels;
}
# The fake room has a normal border colour (default black) and the same interior colour as
# the map itself (default cream)
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $self->borderCornerXPosPixels
+ ($roomObj->xPosBlocks * $self->currentRegionmap->blockWidthPixels) + 1,
'y' => $self->borderCornerYPosPixels
+ ($roomObj->yPosBlocks * $self->currentRegionmap->blockHeightPixels) + 1,
'width' => $roomWidth - 2,
'height' => $roomHeight - 2,
# 'line-width' => 2,
'stroke-color' => $self->drawScheme->borderColour,
'fill-color' => $self->drawScheme->backgroundColour,
);
# Set the canvas object's position in the canvas drawing stack (using same priority as room
# echoes). There is event handler for this canvas object
$levelObj = $self->currentParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 2));
}
# The calling function stores $newObj in an IV
return $newObj;
}
sub drawRoomEcho {
# Called by $self->drawRoom->doQuickDraw
# Draws a room echo for a room just above or just below the current level
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room for which a room echo
# should be drawn
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'no_exit', 'simple_exit' or
# 'complex_exit'
# $echoMode - Set to -1 if the room echo is drawn just below $roomObj, +1 if it's
# drawn just above $roomObj
#
# Return values
# 'undef' on improper arguments or if the room echo can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitMode, $echoMode, $check) = @_;
# Local variables
my (
$canvasWidget, $roomWidth, $roomHeight, $xMod, $yMod, $outlineColour, $fillColour,
$newObj, $levelObj,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitMode || ! defined $echoMode || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRoomEcho', @_);
}
# If the parchment object doesn't have a canvas widget for this room's level, create one
if (
! $self->drawParchment->ivExists('canvasWidgetHash', ($roomObj->zPosBlocks + $echoMode))
) {
$self->createMap(
$self->drawRegionmap,
$self->drawParchment,
($roomObj->zPosBlocks + $echoMode),
);
}
$canvasWidget = $self->drawParchment->ivShow(
'canvasWidgetHash',
($roomObj->zPosBlocks + $echoMode),
);
# In draw exit mode 'no_exit' (draw no exits), the room takes up the whole gridblock
if ($exitMode eq 'no_exit') {
$roomWidth = $self->drawRegionmap->blockWidthPixels;
$roomHeight = $self->drawRegionmap->blockWidthPixels;
# In draw exit mode 'simple_exit'/'complex_exit', the room takes up the middle part of the
# gridblock
} else {
$roomWidth = $self->drawRegionmap->roomWidthPixels;
$roomHeight = $self->drawRegionmap->roomHeightPixels;
}
# A room above the current level should be drawn slightly northwest of the usual position.
# A room below the current level should be drawn slightly southeast
$xMod = int($echoMode * ($roomWidth / 5));
$yMod = int($echoMode * ($roomHeight / 5));
# Set the colours to use
if ($echoMode == 1) {
$outlineColour = $self->drawScheme->roomAboveColour;
$fillColour = $self->drawScheme->backgroundColour;
} else {
$outlineColour = $self->drawScheme->roomBelowColour;
$fillColour = $self->drawScheme->roomBelowColour;
}
# Draw the room echo
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $self->borderCornerXPosPixels + $xMod + 1
+ ($roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels),
'y' => $self->borderCornerYPosPixels + $yMod + 1
+ ($roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels),
'width' => $roomWidth - 2,
'height' => $roomHeight - 2,
# 'line-width' => 2,
'stroke-color' => $outlineColour,
'fill-color' => $fillColour,
);
# Set the canvas object's position in the canvas drawing stack (using same priority as room
# echoes)
$levelObj = $self->drawParchment->ivShow('levelHash', ($roomObj->zPosBlocks + $echoMode));
# We don't check ->quickDrawFlag, as we usually would, because the level that's being drawn
# by a call to $self->doQuickDraw isn't necessarily the one on which the room echo
# appears
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 2));
# Set up the event handler for the canvas object. Pretend that it was a click on the map
# background by calling ->setupCanvasEvent, not ->setupCanvasObjEvent
$self->setupCanvasEvent($newObj);
# Store the canvas object(s)
$self->drawParchment->addDrawnRoomEcho($roomObj, $echoMode, [$newObj]);
# The calling function stores $newObj in an IV
return $newObj;
}
sub drawRoomInteriorInfo {
# Called by $self->drawRoom->doQuickDraw
# Draws information displayed in the room interior. Which information to display depends on
# GA::Obj::WorldModel->roomInteriorMode (for example, in mode 'temp_count', the number of
# living and non-living things in the Locator's current room is displayed)
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
#
# Optional arguments
# $unallocatedCount, $shadowCount
# - The number of exits in this room which are unallocated, and the number
# which have have shadow exits (needed in mode 'shadow_count')
# $regionCount, $superRegionCount
# - The number of exits in this room which are region exits, and the
# number which are super-region exits (needed in mode 'region_count')
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $borderCornerXPosPixels, $borderCornerYPosPixels,
$unallocatedCount, $shadowCount, $regionCount, $superRegionCount, $check
) = @_;
# Local variables
my (
$mode, $checkedCount, $checkableCount, $livingCount, $nonLivingCount, $file,
$assistedCount, $patternCount,
@list,
%checkHash,
);
# Check for improper arguments
if (
! defined $roomObj || ! defined $canvasWidget || ! defined $borderCornerXPosPixels
|| ! defined $borderCornerYPosPixels || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRoomInteriorInfo', @_);
}
# Import the world model's room interior mode IV
$mode = $self->worldModelObj->roomInteriorMode;
# Display the number of unallocated / shadow exits
if ($mode eq 'shadow_count' && ($unallocatedCount || $shadowCount)) {
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$unallocatedCount,
$shadowCount,
);
# Draw the number of region/super-region exits
} elsif ($mode eq 'region_count' && ($regionCount || $superRegionCount)) {
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$regionCount,
$superRegionCount,
);
# Draw the number of checked/checkable directions
} elsif ($mode eq 'checked_count') {
# Count the number of checked and checkable directions
$checkedCount = 0;
%checkHash = $self->preCountCheckedHash;
foreach my $dir ($roomObj->ivKeys('checkedDirHash')) {
$checkedCount++;
delete $checkHash{$dir};
}
foreach my $dir ($roomObj->sortedExitList) {
delete $checkHash{$dir};
}
# Checkable directions are all those that remain in the hash
$checkableCount = scalar (keys %checkHash);
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$checkedCount,
$checkableCount,
);
# Draw the number of living and non-living objects contained in the room
} elsif ($mode eq 'room_content' || $mode eq 'hidden_content') {
# Count the number of living and non-living things
$livingCount = 0;
$nonLivingCount = 0;
# Count either permanent, or only hidden, objects (which are usually also in the room's
# permanent object list too), depending on the value of $mode
if ($mode eq 'room_content') {
@list = $roomObj->ivKeys('childHash');
} else {
# (Mode 'hidden_content')
@list = $roomObj->ivKeys('hiddenObjHash');
}
foreach my $number (@list) {
my $obj = $self->worldModelObj->ivShow('modelHash', $number);
if ($obj) {
if ($obj->aliveFlag) {
$livingCount++;
} else {
$nonLivingCount++;
}
}
}
if ($livingCount || $nonLivingCount) {
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$livingCount,
$nonLivingCount,
);
}
# Draw the number of living and non-living (temporary) objects in the room, the last time it
# was visited (if known)
} elsif ($mode eq 'temp_count') {
# Retrieve the counts
$livingCount = 0;
$nonLivingCount = 0;
if ($self->drawRegionmap->ivExists('livingCountHash', $roomObj->number)) {
$livingCount = $self->drawRegionmap->ivShow('livingCountHash', $roomObj->number);
}
if ($self->drawRegionmap->ivExists('nonLivingCountHash', $roomObj->number)) {
$nonLivingCount = $self->drawRegionmap->ivShow(
'nonLivingCountHash',
$roomObj->number,
);
}
if ($livingCount || $nonLivingCount) {
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$livingCount,
$nonLivingCount,
);
}
# Draw the number of recognised nouns and adjectives in the room
} elsif ($mode eq 'word_count' && ($roomObj->nounList || $roomObj->adjList)) {
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$roomObj->ivNumber('nounList'),
$roomObj->ivNumber('adjList'),
);
# Draw the room tag
} elsif ($mode eq 'room_tag' && $roomObj->roomTag) {
# Don't worry if the text is bigger than the room box (nothing we can do about it)
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
0, # Top-left corner
$roomObj->roomTag,
);
# Draw the highest-priority room flag
} elsif ($mode eq 'room_flag' && $roomObj->lastRoomFlag) {
$self->drawRoomFlagText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$roomObj->lastRoomFlag,
);
# Draw character visits
} elsif ($mode eq 'visit_count') {
$self->drawInteriorVisits(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
);
# Draw matching rooms
} elsif (
$mode eq 'compare_count'
&& $self->mapObj->currentRoom
&& $self->mapObj->currentRoom eq $roomObj
) {
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
scalar ($self->mapObj->currentMatchList),
0,
);
# Draw room's exclusive profiles
} elsif ($mode eq 'profile_count' && ($roomObj->exclusiveFlag || $roomObj->exclusiveHash)) {
$self->drawInteriorProfiles(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
);
# Draw room titles/verbose descriptions
} elsif ($mode eq 'title_descrip' && ($roomObj->titleList || $roomObj->descripHash)) {
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$roomObj->ivNumber('titleList'),
$roomObj->ivPairs('descripHash'),
);
# Draw assisted moves and exit patterns
} elsif ($mode eq 'exit_pattern') {
# Count assisted moves for each exit
$assistedCount = 0;
foreach my $exitNum ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
$assistedCount += $exitObj->ivPairs('assistedHash');
}
# Count fail exit (etc) patterns
$patternCount = $roomObj->ivNumber('failExitPatternList')
+ $roomObj->ivNumber('specialDepartPatternList')
+ $roomObj->ivPairs('involuntaryExitPatternHash')
+ $roomObj->ivPairs('repulseExitPatternHash');
$self->drawInteriorCounts(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$assistedCount,
$patternCount,
);
# Drawm room's source code path
} elsif ($mode eq 'source_code' && $roomObj->sourceCodePath) {
$self->drawRoomSourceText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
);
# Draw room's grid position
} elsif ($mode eq 'grid_posn' && defined $roomObj->xPosBlocks) {
# Don't worry if the text is bigger than the room box (nothing we can do about it)
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
0, # Top-left corner
($roomObj->xPosBlocks + $self->worldModelObj->roomInteriorXOffset),
);
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
2, # Bottom-left corner
($roomObj->yPosBlocks + $self->worldModelObj->roomInteriorYOffset),
);
# Draw world's room vnum
} elsif ($mode eq 'vnum' && $roomObj->ivExists('protocolRoomHash', 'vnum')) {
# Don't worry if the number is bigger than the room box (nothing we can do about it)
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
0, # Top-left corner
$roomObj->ivShow('protocolRoomHash', 'vnum'),
);
}
return 1;
}
sub drawInteriorText {
# Called by $self->drawUpDown, ->drawInteriorCounts, ->drawInteriorVisits,
# ->drawInteriorText and ->drawRoomFlagText
# Draws some pango text in a room's interior at ones of five positions - the top-left or
# top-right corners, or at the bottom-left, bottom-centre or bottom-right
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
# $corner - Which corner to use
# - 0 for top-left
# - 1 for top-right
# - 2 for bottom-left (reserved for 'up' exits)
# - 3 for bottom-centre (reserved for unallocatable exits)
# - 4 for bottom-right (reserved for 'down' exits)
#
# Optional arguments
# $text - The text to draw. If an empty string or 'undef', nothing is drawn
# $style - The text's style, 'normal', 'oblique' or 'italic'. If 'undef',
# 'normal' is used
# $underline - The text's underline, 'none', 'single', 'double', 'low' or 'error'. If
# 'undef', 'none' is used (NB Only intended to be used for up/down
# exits)
# $weight - The text's weight. A normal weight is 400; a bold weight is 600. If
# 'undef', 400 is used (NB Only intended to be used for up/down exits)
#
# Return values
# 'undef' on improper arguments, or if the text is too small to be drawn
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $borderCornerXPosPixels, $borderCornerYPosPixels,
$corner, $text, $style, $underline, $weight, $check
) = @_;
# Local variables
my ($textXPosPixels, $textYPosPixels, $markup, $yMod, $newObj, $levelObj);
# Check for improper arguments
if (
! defined $roomObj || ! $canvasWidget || ! defined $borderCornerXPosPixels
|| ! defined $borderCornerYPosPixels || ! defined $corner || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawInteriorText', @_);
}
# Check that, for very small rooms, we don't try to draw text with a size of less than 1
# pixel
if ($self->drawRoomTextSize < 1) {
# Draw nothing
return undef;
}
# Set the text's position
if ($corner == 0) {
# Top-left corner
$textXPosPixels = $borderCornerXPosPixels + 1;
$textYPosPixels = $borderCornerYPosPixels + 1;
} elsif ($corner == 1) {
# Top-right corner
$textXPosPixels = $borderCornerXPosPixels + int($self->drawRoomTextWidth / 2) + 1;
$textYPosPixels = $borderCornerYPosPixels + 1;
} elsif ($corner == 2) {
# Bottom-left corner (reserved for 'up')
$textXPosPixels = $borderCornerXPosPixels + 1;
$textYPosPixels = $borderCornerYPosPixels + int($self->drawRoomTextHeight / 2) + 1;
} elsif ($corner == 3) {
# Bottom-centre (reserved for unallocatable exits)
$textXPosPixels = $borderCornerXPosPixels + int($self->drawRoomTextWidth / 3) + 1;
$textYPosPixels = $borderCornerYPosPixels + int($self->drawRoomTextHeight / 2) + 1;
} elsif ($corner == 4) {
# Bottom right-corner (reserved for 'down')
$textXPosPixels = $borderCornerXPosPixels + int(($self->drawRoomTextWidth * 2) / 3);
$textYPosPixels = $borderCornerYPosPixels + int($self->drawRoomTextHeight / 2) + 1;
}
# Set the style, underline and weight attributes. Some underline settings need us to move
# the characters up a few pixels, in which case $yMod is set
$markup = '<span ';
if (! $style) {
$markup .= ' font_style="normal"';
} else {
$markup .= ' font_style="' . $style . '"';
}
$yMod = 0;
if (! $underline || $underline eq 'none') {
$markup .= ' underline="none"';
} else {
$markup .= ' underline="' . $underline . '"';
if ($underline eq 'single' || $underline eq 'low') {
$yMod = -1;
} elsif ($underline eq 'double' || $underline eq 'error') {
$yMod = -2;
}
}
if (! $weight) {
$markup .= ' weight=\'400\'';
} else {
$markup .= ' weight=\'' . $weight . '\'';
}
$markup .= '>' . $text . '</span>';
# Draw the canvas object
$newObj = GooCanvas2::CanvasText->new(
'parent' => $canvasWidget->get_root_item(),
# 'anchor' => 'nw',
'x' => $textXPosPixels,
'y' => $textYPosPixels + $yMod,
'font' => $self->worldModelObj->mapFont . ' '
. int($self->drawRoomTextSize * $self->worldModelObj->roomTextRatio),
'use-markup' => TRUE,
'text' => $markup,
'width' => -1,
'fill-color' => $self->drawScheme->roomTextColour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 4));
}
# (No event handler for this canvas object)
# Store the canvas object
$self->drawParchment->addDrawnRoomText($roomObj, [$newObj]);
return 1;
}
sub drawUnallocatableCount {
# Called by $self->drawRoom->doQuickDraw to display the number of unallocatable exits for
# this room in the bottom-centre of the room box
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $count - The number of unallocatable exits in this room
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $roomObj, $canvasWidget, $count, $check) = @_;
# Local variables
my ($xPos, $yPos, $text);
# Check for improper arguments
if (! defined $roomObj || ! defined $canvasWidget || ! defined $count || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawUnallocatableCount', @_);
}
# There's only room to draw a single figure so, if $count > 9, draw a '+'
if ($count > 9) {
$count = '+';
}
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw the letter
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$self->borderCornerXPosPixels + $xPos,
$self->borderCornerYPosPixels + $yPos,
3, # Bottom-centre
$count,
'normal',
);
return 1;
}
sub drawInteriorCounts {
# Called by $self->drawRoomInteriorInfo
# Draws up to two numbers in the room's interior, giving information about its exits and/or
# contents
# Because of limited space, the maximum number drawn is 9. Numbers above that are drawn as a
# '+'. The number 0 is not drawn at all
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
# $leftCount - The number drawn in the top-left of the room's interior
# $rightCount - The number drawn in the top-right of the room's interior
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $borderCornerXPosPixels, $borderCornerYPosPixels,
$leftCount, $rightCount, $check,
) = @_;
# Check for improper arguments
if (
! defined $roomObj || ! defined $canvasWidget || ! defined $borderCornerXPosPixels
|| ! defined $borderCornerYPosPixels || ! defined $leftCount || ! defined $rightCount
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawInteriorCounts', @_);
}
# Set maximum numbers
if ($leftCount && $leftCount > 9) {
$leftCount = '+';
}
if ($rightCount && $rightCount > 9) {
$rightCount = '+';
}
if ($leftCount) {
# Draw the count
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
0, # Top-left corner
$leftCount,
);
}
if ($rightCount) {
# Draw the count
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
1, # Top-right corner
$rightCount,
);
}
return 1;
}
sub drawRoomFlagText {
# Called by $self->drawRoomInteriorInfo
# Draws the room flag text - two letters which are equivalent to the room's highest-priority
# room flag - in the room's interior
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
# $roomFlag - The room flag to draw. Matches a key in
# GA::Obj::WorldModel->roomFlagHash
#
# Return values
# 'undef' on improper arguments, or if the correct room flag text can't be found
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $borderCornerXPosPixels, $borderCornerYPosPixels,
$roomFlag, $check,
) = @_;
# Local variables
my $roomFlagObj;
# Check for improper arguments
if (
! defined $roomObj || ! defined $canvasWidget || ! defined $borderCornerXPosPixels
|| ! defined $borderCornerYPosPixels || ! defined $roomFlag || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRoomFlagText', @_);
}
# Get the short name itself (A two-letter scalar, e.g. 'St' for stash rooms)
$roomFlagObj = $self->worldModelObj->ivShow('roomFlagHash', $roomFlag);
if ($roomFlagObj) {
# Draw the label
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
0, # Top-left corner
$roomFlagObj->shortName,
);
}
return 1;
}
sub drawRoomSourceText {
# Called by $self->drawRoomInteriorInfo
# Draws the first four letters of the room's filename in the room's interior (this function
# assumes that the room has a ->sourceCodePath value set)
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
#
# Return values
# 'undef' on improper arguments, or if the correct room flag text can't be found
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $borderCornerXPosPixels, $borderCornerYPosPixels,
$check,
) = @_;
# Local variables
my $text;
# Check for improper arguments
if (
! defined $roomObj || ! defined $canvasWidget || ! defined $borderCornerXPosPixels
|| ! defined $borderCornerYPosPixels || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRoomSourceText', @_);
}
# Split a file path like /home/name/ds/lib/domains/town/room/start.c into path,
# filename and extension (we only want the filename)
$roomObj->sourceCodePath =~ m/^(.*\/)?(?:$|(.+?)(?:(\.[^.]*$)|$))/;
# Get the first three characters of the filename (e.g. 'sta')
$text = substr($2, 0, 3);
if ($text) {
# Draw the text
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
0, # Top-left corner
$text,
);
}
return 1;
}
sub drawInteriorVisits {
# Called by $self->drawRoomInteriorInfo
# Draws a single number in the room's interior, showing the number of times a character has
# visited the room
# Because of limited space, the maximum number drawn is 999. Numbers above that are drawn
# as '1k', '2k', or even '1m' (etc). The number 0 is not drawn at all
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $borderCornerXPosPixels, $borderCornerYPosPixels,
$check,
) = @_;
# Local variables
my ($name, $visitCount);
# Check for improper arguments
if (
! defined $roomObj || ! defined $canvasWidget || ! defined $borderCornerXPosPixels
|| ! defined $borderCornerYPosPixels || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawInteriorVisits', @_);
}
# If $self->showChar specifies a character, show that character's visits. Otherwise, show
# visits of the current character (if there is one)
if ($self->showChar) {
$name = $self->showChar;
} elsif ($self->session->currentChar) {
$name = $self->session->currentChar->name;
}
if ($name && $roomObj->ivExists('visitHash', $name)) {
# Get the number of times character $name has visited the room $roomObj
$visitCount = $roomObj->ivShow('visitHash', $name);
# Set maximum number to draw (because of limited space inside the room)
if ($visitCount && $visitCount > 999999) {
$visitCount = '1m+'; # Absolute maximum
} elsif ($visitCount > 999) {
$visitCount = int($visitCount / 1000) . 'k';
}
# Draw the number of visits
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
0, # Top-left corner
$visitCount,
);
}
return 1;
}
sub drawInteriorProfiles {
# Called by $self->drawRoomInteriorInfo
# Draws two bits of text in the room's interior - a symbol to show whether the room's
# ->exclusiveFlag is set, and the number of exclusive profiles for the room (if there
# is only one, the first two characters of the profile's name are drawn instead)
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my (
$self, $roomObj, $canvasWidget, $borderCornerXPosPixels, $borderCornerYPosPixels,
$check,
) = @_;
# Local variables
my (
$string,
@profList,
);
# Check for improper arguments
if (
! defined $roomObj || ! defined $canvasWidget || ! defined $borderCornerXPosPixels
|| ! defined $borderCornerYPosPixels || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawInteriorProfiles', @_);
}
# Create a string to draw
if ($roomObj->exclusiveFlag) {
$string = '*';
} else {
$string = ' ';
}
if ($roomObj->exclusiveHash) {
@profList = $roomObj->ivKeys('exclusiveHash');
# Only one exclusive profile, so use its name
if (@profList == 1) {
$string .= substr($profList[0], 0, 3);
# More than one exclusive profile, so use the number of profiles
} elsif (@profList > 99) {
# Number is too large to fit
$string .= '99+';
} else {
$string .= scalar @profList;
}
}
# Draw the string
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
0, # Top-left corner
$string,
);
return 1;
}
sub drawUpDown {
# Called by $self->drawIncompleteExit, $self->drawOneWayExit, $self->drawTwoWayExit (etc)
# To show the exits 'up' and 'down', draws the letter 'U' or 'D' in one of the bottom
# corners of a room on the map
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $roomObj, $exitObj, $canvasWidget, $check) = @_;
# Local variables
my ($mapDir, $xPos, $yPos, $text, $style, $weight, $underline);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $canvasWidget || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawUpDown', @_);
}
# Get the primary direction ('up' or 'down'). The calling function should already have
# eliminated exits whose ->mapDir is set to other values (or to 'undef')
$mapDir = $exitObj->mapDir;
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Broken/region exits are drawn with an underline
if ($exitObj->brokenFlag) {
$underline = 'single';
} elsif ($exitObj->regionFlag) {
$underline = 'error'; # Wavy line
}
# Impassable, mystery and retracing exits are drawn bold. Other exit ornaments are drawn
# oblique
if (
$exitObj->exitOrnament eq 'impass'
|| $exitObj->exitOrnament eq 'mystery'
|| $exitObj->retraceFlag
) {
$weight = 600;
$style = 'normal';
} else {
$weight = 400;
if ($exitObj->exitOrnament ne 'none') {
$style = 'oblique';
} elsif ($exitObj->randomType ne 'none') {
$style = 'italic';
} else {
$style = 'normal';
}
}
# Set the letter to be used, and its size and position
if ($mapDir eq 'up') {
# Decide which letter to use (upper case for 1-way/2-way exits, lower case for
# uncertain/incomplete exits)
if ($exitObj->twinExit || $exitObj->oneWayFlag) {
$text = 'U';
} else {
$text = 'u';
}
# Draw the letter
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$self->borderCornerXPosPixels + $xPos,
$self->borderCornerYPosPixels + $yPos,
2, # Bottom-left corner
$text,
$style,
$underline,
$weight,
);
} elsif ($mapDir eq 'down') {
# Decide which letter to use (upper case for 1-way/2-way exits, lower case for
# uncertain/incomplete exits)
if ($exitObj->twinExit || $exitObj->oneWayFlag) {
$text = 'D';
} else {
$text = 'd';
}
# Draw the letter
$self->drawInteriorText(
$roomObj,
$canvasWidget,
$self->borderCornerXPosPixels + $xPos,
$self->borderCornerYPosPixels + $yPos,
4, # Bottom-right corner
$text,
$style,
$underline,
$weight,
);
}
return 1;
}
sub drawIncompleteExit {
# Called by $self->drawExit to draw an exit with an unknown destination
# The exit is drawn almost to the edge of the gridblock, so that it's clear the exit doesn't
# necessarily lead to adjacent rooms
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $ornamentsFlag - Matches the ->drawOrnamentsFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $ornamentsFlag, $canvasWidget, $check) = @_;
# Local variables
my ($mapDir, $posnListRef, $colour, $xPos, $yPos, $newObj, $levelObj);
# Check for improper arguments
if (
! defined $roomObj || ! defined $exitObj || ! defined $ornamentsFlag
|| ! defined $canvasWidget || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawIncompleteExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Find the exit's position
$posnListRef = $self->ivShow('preDrawnIncompleteExitHash', $mapDir);
# Decide which colour to use
$colour = $self->getExitColour($exitObj);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef[2] + $xPos)
. ' ' . ($$posnListRef[3] + $yPos),
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
# Draw ornaments for this exit, if there are any (and if allowed)
if ($exitObj->exitOrnament ne 'none' && $ornamentsFlag) {
$self->drawExitOrnaments(
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
undef, # No twin exit object
undef, # No destination room
undef,
$posnListRef,
);
}
}
return 1;
}
sub drawUncertainExit {
# Called by $self->drawExit to draw an uncertain exit (when we know we can go 'north' from
# A to B, but we don't yet know if we can go 'south' from B to A)
# The exit is drawn longer than an incomplete exit, so we can see from the map which of the
# two linked exits we already know about, and which we don't
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $ornamentsFlag - Matches the ->drawOrnamentsFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $ornamentsFlag, $canvasWidget, $check) = @_;
# Local variables
my ($mapDir, $posnListRef, $colour, $xPos, $yPos, $newObj, $levelObj);
# Check for improper arguments
if (
! defined $roomObj || ! defined $exitObj || ! defined $ornamentsFlag
|| ! defined $canvasWidget || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawUncertainExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Find the exit's position
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $mapDir);
# Decide which colour to use
$colour = $self->getExitColour($exitObj);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef[2] + $xPos)
. ' ' . ($$posnListRef[3] + $yPos),
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
# Draw ornaments for this exit, if there are any (and if allowed)
if ($exitObj->exitOrnament ne 'none' && $ornamentsFlag) {
$self->drawExitOrnaments(
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
undef, # No twin exit object
undef, # No destination room
undef,
$posnListRef,
);
}
}
return 1;
}
sub drawOneWayExit {
# Called by $self->drawExit to draw a one-way exit. The exit is drawn all the way from one
# room to the other. (Also called by $self->drawBentExit in certain circumstances)
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $ornamentsFlag - Matches the ->drawOrnamentsFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $ornamentsFlag, $canvasWidget, $check) = @_;
# Local variables
my (
$mapDir, $oneWayDir, $destRoomObj, $posnListRef, $destXPos, $destYPos, $posnListRef2,
$alignMode, $xPos, $yPos, $colour, $arrowVectorRef, $arrowHead, $newObj, $levelObj,
$twinExitObj,
);
# Check for improper arguments
if (
! defined $roomObj || ! defined $exitObj || ! defined $ornamentsFlag
|| ! defined $canvasWidget || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawOneWayExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is
# drawn on the map)
$mapDir = $exitObj->mapDir;
$oneWayDir = $exitObj->oneWayDir;
if (! $mapDir || ! $oneWayDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# $exitObj is supposed to touch the destination room at the point at which a
# hypothetical exit in the direction $exitObj->oneWayDir is drawn (e.g. if ->mapDir
# is 'east', ->oneWayDir is, by default, 'west')
# Find out if the destination room has an exit (an incomplete exit, or some other kind
# of exit which doesn't lead back to $roomObj) drawn in the ->oneWayDir direction
# If so, the one-way exit is drawn to the edge of its own gridblock; if not, the
# one-way exit is drawn all the way to the destination room
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->destRoom);
if (! $destRoomObj->ivExists('exitNumHash', $oneWayDir)) {
# Draw this exit all the way to the destination room.
# Find the exit's position
$posnListRef = $self->ivShow('preDrawnLongExitHash', $mapDir);
# Get the position of the destination room's gridblock
$destXPos = $destRoomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$destYPos = $destRoomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# If ->mapDir and ->oneWayDir are not opposites, then we can't use
# $self->preDrawnLongExitHash to draw the far end of the exit
if (
$axmud::CLIENT->ivShow('constOppDirHash', $mapDir) eq $oneWayDir
) {
$posnListRef2 = $self->ivShow('preDrawnLongExitHash', $oneWayDir);
$alignMode = 'opposite';
} else {
$posnListRef2 = $self->ivShow('preDrawnUncertainExitHash', $oneWayDir);
$alignMode = 'not_opposite';
}
} else {
# Draw this exit to the edge of its own gridblock
# Find the exit's position (as if it were an uncertain exit)
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $mapDir);
$alignMode = 'edge';
}
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Decide which colour to use
$colour = $self->getExitColour($exitObj);
# Find the exit's arrow vector - a reference to a list, (x1, y1, x2, y2)
# (x1, y1) is a vector showing the direction of one half of the arrowhead, starting at
# the edge of the block. (x2, y2) is a vector showing the direction of travel of the
# other half
# (NB The calling function has already checked that $exitObj->mapDir is defined)
$arrowVectorRef = $self->ivShow('constArrowVectorHash', $exitObj->mapDir);
# Prepare the arrowhead, as a list of points
$arrowHead = $self->prepareArrowHead($exitObj, $xPos, $yPos, $posnListRef);
# Draw the canvas object for the line part of the exit
if ($alignMode eq 'opposite') {
# Draw this exit all the way to the destination room, where $mapDir and $oneWayDir
# are opposites
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef2[0] + $destXPos)
. ' ' . ($$posnListRef2[1] + $destYPos)
. $arrowHead,
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
} elsif ($alignMode eq 'not_opposite') {
# Draw this exit all the way to the destination room, where $mapDir and $oneWayDir
# are not opposites
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef[2] + $xPos)
. ' ' . ($$posnListRef[3] + $yPos)
. ' L ' . ($$posnListRef2[2] + $destXPos)
. ' ' . ($$posnListRef2[3] + $destYPos)
. ' L ' . ($$posnListRef2[0] + $destXPos)
. ' ' . ($$posnListRef2[1] + $destYPos)
. $arrowHead,
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
} else {
# Draw this exit to the edge of its own gridblock
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef[2] + $xPos)
. ' ' . ($$posnListRef[3] + $yPos)
. $arrowHead,
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
}
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
# Draw ornaments for this exit and/or the twin exit, if there are any (and if allowed)
if ($ornamentsFlag) {
if ($exitObj->twinExit) {
$twinExitObj
= $self->worldModelObj->ivShow('exitModelHash', $exitObj->twinExit);
}
if (
$exitObj->exitOrnament ne 'none'
|| ($twinExitObj && $twinExitObj->exitOrnament ne 'none')
) {
$self->drawExitOrnaments(
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
$twinExitObj,
$destXPos,
$destYPos,
);
}
}
}
return 1;
}
sub drawTwoWayExit {
# Called by $self->drawExit to draw a two-way exit. The exit is drawn as two parallel lines
# all the way from one room to the other
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'simple_exit' or 'complex_exit'
# $ornamentsFlag - Matches the ->drawOrnamentsFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $exitMode, $ornamentsFlag, $canvasWidget, $check) = @_;
# Local variables
my (
$mapDir, $posnListRef, $vectorRef, $doubleVectorRef, $colour, $xPos, $yPos,
$destRoomObj, $destXPos, $destYPos, $newObj, $levelObj, $twinExitObj,
);
# Check for improper arguments
if (
! defined $roomObj || ! defined $exitObj || ! defined $exitMode
|| ! defined $ornamentsFlag || ! defined $canvasWidget || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawTwoWayExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Find the exit's position
$posnListRef = $self->ivShow('preDrawnLongExitHash', $mapDir);
# Find the exit's vector - a reference to a list of 3d coordinates, (x, y, z)
# e.g. northeast > (1, 1, 0)
$vectorRef = $self->ivShow('constVectorHash', $mapDir);
# Find the exit's double vector - a reference to a list of 3d coordinates,
# (x1, y1, x2, y2) which we add to the start and stop pixels of what would have been a
# single line, to produce two parallel lines either side of it
$doubleVectorRef = $self->ivShow('constDoubleVectorHash', $mapDir);
# Decide which colour to use
$colour = $self->getExitColour($exitObj);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Get the position of the destination room's griblock
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->destRoom);
$destXPos = $destRoomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$destYPos = $destRoomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
if ($exitMode eq 'complex_exit') {
# (Complex exits) For diagonal two-way exits, we have a small problem
# We need to increase the length of each of the two lines by two pixels, to
# compensate for the fact that each line is being drawn 2 pixels closer to one of
# the rooms (and one pixel further away from the others)
# When the exit is diagonal, $$vectorRef[0] and $$vectorRef[1] both equal either 2
# or -2
# Draw the canvas objects
if ($$vectorRef[0] && $$vectorRef[1] && ! $$vectorRef[2]) {
# It's a diagonal two-way exit
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
# First line
'M ' . ($$posnListRef[0] + $xPos + $$doubleVectorRef[0])
. ' ' . ($$posnListRef[1] + $yPos + $$doubleVectorRef[1])
. ' L ' . (
$$posnListRef[4] + $destXPos + $$doubleVectorRef[0]
+ ($$vectorRef[0] * 2)
)
. ' ' . (
$$posnListRef[5] + $destYPos + $$doubleVectorRef[1]
+ ($$vectorRef[1] * 2)
)
# Second line
. ' M ' . ($$posnListRef[0] + $xPos + $$doubleVectorRef[2])
. ' ' . ($$posnListRef[1] + $yPos + $$doubleVectorRef[3])
. ' L ' . (
$$posnListRef[4] + $destXPos + $$doubleVectorRef[2]
+ ($$vectorRef[0] * 2)
)
. ' ' . (
$$posnListRef[5] + $destYPos + $$doubleVectorRef[3]
+ ($$vectorRef[1] * 2)
),
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
} else {
# It's not a diagonal two-way exit
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
# First line
'M ' . ($$posnListRef[0] + $xPos + $$doubleVectorRef[0])
. ' ' . ($$posnListRef[1] + $yPos + $$doubleVectorRef[1])
. ' L ' . ($$posnListRef[4] + $destXPos + $$doubleVectorRef[0])
. ' ' . ($$posnListRef[5] + $destYPos + $$doubleVectorRef[1])
# Second line
. ' M ' . ($$posnListRef[0] + $xPos + $$doubleVectorRef[2])
. ' ' . ($$posnListRef[1] + $yPos + $$doubleVectorRef[3])
. ' L ' . ($$posnListRef[4] + $destXPos + $$doubleVectorRef[2])
. ' ' . ($$posnListRef[5] + $destYPos + $$doubleVectorRef[3]),
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
}
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handlers for the canvas objects
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas objects together
$self->drawParchment->addDrawnExit(
$roomObj,
$exitObj,
[$newObj],
);
} else {
# (Simple exits) Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef[4] + $destXPos)
. ' ' . ($$posnListRef[5] + $destYPos),
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
}
# Draw ornaments for this exit and/or the twin exit, if there are any (and if allowed)
if ($ornamentsFlag) {
if ($exitObj->twinExit) {
$twinExitObj
= $self->worldModelObj->ivShow('exitModelHash', $exitObj->twinExit);
}
if (
$exitObj->exitOrnament ne 'none'
|| ($twinExitObj && $twinExitObj->exitOrnament ne 'none')
) {
$self->drawExitOrnaments(
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
$twinExitObj,
$destXPos,
$destYPos,
);
}
}
}
return 1;
}
sub drawUnallocatedExit {
# Called by $self->drawExit to draw an exit in a non-primary direction, which has been
# allocated a (temporary) primary direction (it's up to the user to allocate the primary
# direction they actually want)
# The exit is drawn as an 'x'
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $canvasWidget, $check) = @_;
# Local variables
my ($mapDir, $posnListRef, $colour, $xPos, $yPos, $newObj, $levelObj);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $canvasWidget || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawUnallocatedExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Find the exit's position
$posnListRef = $self->ivShow('preDrawnSquareExitHash', $mapDir);
# Decide which colour to use
$colour = $self->getExitColour($exitObj);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef[2] + $xPos)
. ' ' . ($$posnListRef[3] + $yPos)
. ' M ' . ($$posnListRef[2] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[3] + $yPos),
'line-width' => 1,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handlers for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
}
return 1;
}
sub drawImpassableExit {
# Called by $self->drawExit to draw an exit which is impassable, or an exit whose twin
# exit is impassable
# (Also called for a mystery exit or an exit whose twin is a mystery exit)
#
# This is the only one of the draw functions which draws an exit and an exit ornament at the
# same time, in the same function
# If one of the exits drawn here isn't impassable/mystery, it's drawn in the same colour as
# the impassable/myster exit (default purple/dark red) and without its own exit ornaments
# (if there are any)
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Optional arguments
# $twinExitObj - The twin GA::Obj::Exit, if there is one ('undef' otherwise)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $roomObj, $exitObj, $canvasWidget, $twinExitObj, $check) = @_;
# Local variables
my (
$twinRoomObj, $colour, $levelObj,
@list,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $canvasWidget || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawImpassableExit', @_);
}
# If the twin exit's room is in a different region or on a different level, then we
# don't draw it using this function
if ($twinExitObj) {
# Get the parent room of $twinExitObj
$twinRoomObj = $self->worldModelObj->ivShow('modelHash', $twinExitObj->parent);
if (
! $twinRoomObj
|| $roomObj->parent ne $twinRoomObj->parent
|| $roomObj->zPosBlocks ne $twinRoomObj->zPosBlocks
) {
# Don't draw the twin exit right now
$twinExitObj = undef;
$twinRoomObj = undef;
}
}
# Decide which colour to use. If one of the exits is not impassable/mystery, it's drawn in
# the same colour (default purple/dark red) as the one that is impassable/mystery
# If either of them are selected, then of course they'll be both drawn in the selected
# object colour (default blue)
if ($exitObj->exitOrnament eq 'impass' || $exitObj->exitOrnament eq 'mystery') {
$colour = $self->getExitColour($exitObj);
} elsif (
$twinExitObj
&& ($twinExitObj->exitOrnament eq 'impass' || $twinExitObj->exitOrnament eq 'mystery')
) {
$colour = $self->getExitColour($twinExitObj);
}
# If @exitList contains two exits, one (or both) of them are impassable/mystery. If one is
# not impassable/mystery, it's drawn like an uncertain exit would be drawn
# If @exitList contains one exit, it's definitely impassable/mystery
@list = ($exitObj, $roomObj, $twinExitObj, $twinRoomObj);
do {
my ($thisExitObj, $thisRoomObj, $mapDir, $xPos, $yPos, $posnListRef, $newObj);
$thisExitObj = shift @list;
$thisRoomObj = shift @list;
# Don't try to draw a twin exit if there isn't one
if (defined $thisExitObj) {
# Fetch the equivalent primary direction (the direction in which the exit is drawn
# on the map)
$mapDir = $thisExitObj->mapDir;
}
if ($mapDir) {
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($thisRoomObj, $thisExitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and
# 'down')
} else {
# Get the position of $thisRoomObj's gridblock
$xPos = $thisRoomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $thisRoomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
if (
$thisExitObj->exitOrnament eq 'impass'
|| $thisExitObj->exitOrnament eq 'mystery'
) {
# Draw an impassable/mystery exit. Find the exit's position
$posnListRef = $self->ivShow('preDrawnSquareExitHash', $mapDir);
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $xPos + $$posnListRef[0],
'y' => $yPos + $$posnListRef[3],
'width' => $$posnListRef[2] - $$posnListRef[0],
'height' => $$posnListRef[1] - $$posnListRef[3],
'line-width' => 0,
# 'stroke-color' => $colour,
'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object (using the first exit in
# @exitList, even if there are two)
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
} else {
# Draw a non-impassable/mystery exit whose twin is impassable/mystery. Find
# the exit's position
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $mapDir);
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($$posnListRef[0] + $xPos)
. ' ' . ($$posnListRef[1] + $yPos)
. ' L ' . ($$posnListRef[2] + $xPos)
. ' ' . ($$posnListRef[3] + $yPos),
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object (using the first exit in
# @exitList, even if there are two)
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
}
}
}
} until (! @list);
return 1;
}
sub drawCheckedDir {
# Called by $self->drawRoom->doQuickDraw to draw a checked direction (after a character
# tries to move in a certain direction, and that attempt generates a failed exit message)
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $dir - The checked direction (a custom primary or secondary direction)
#
# Return values
# 'undef' on improper arguments or if the exit isn't drawn
# Returns the new canvas object on success
my ($self, $roomObj, $canvasWidget, $dir, $check) = @_;
# Local variables
my ($xPos, $yPos, $posnListRef, $colour, $newObj, $levelObj);
# Check for improper arguments
if (! defined $roomObj || ! defined $canvasWidget || ! defined $dir || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawCheckedDir', @_);
}
# Don't draw the checked direction if it's not in a primary direction
if (! $self->session->currentDict->checkPrimaryDir($dir)) {
return undef;
}
# Get the position of $thisRoomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Find the position of an exit drawn in this direction
$posnListRef = $self->ivShow('preDrawnSquareExitHash', $dir);
# Get the colour for checked directions
$colour = $self->drawScheme->checkedDirColour;
# Draw the canvas object
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $xPos + $$posnListRef[0],
'y' => $yPos + $$posnListRef[3],
'width' => $$posnListRef[2] - $$posnListRef[0],
'height' => $$posnListRef[1] - $$posnListRef[3],
'line-width' => 0,
# 'stroke-color' => $colour,
'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# (There is no event handler for the canvas object - clicking the checked direction does
# nothing)
# The canvas objects for checked directions in each room are stored together, so let the
# calling function add an entry to GA::Obj::Parchment->drawnCheckedDirHash
return $newObj;
}
sub drawBentExit {
# Called by $self->drawExit to draw an exit that leads to another room at an arbitrary
# position in this region (and not necessarily on the same level). 'Bent' broken exits are
# drawn as a line with one or more bends
# (Also called by $self->continueDrag)
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $exitMode - Matches the ->drawExitMode IV in GA::Obj::WorldModel or
# $self->drawRegionmap; set to 'simple_exit' or 'complex_exit'
# $ornamentsFlag - Matches the ->drawOrnamentsFlag IV in GA::Obj::WorldModel or
# $self->drawRegionmap
#
# Optional arguments
# $twinExitObj - The exit's twin (if it has one - must be specified, if so; set to
# 'undef', if not)
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my (
$self, $roomObj, $exitObj, $exitMode, $ornamentsFlag, $twinExitObj, $canvasWidget,
$check
) = @_;
# Local variables
my (
$destRoomObj, $mapDir, $xPos, $yPos, $colour, $posnListRef, $destXPos, $destYPos,
$posnListRef2, $vectorRef, $doubleVectorRef, $listRef2, $listRef3, $points, $newObj,
$levelObj, $bendSize,
@pointList, @offsetList, @pointList2, @pointList3, @canvasObjList,
);
# Check for improper arguments
if (
! defined $roomObj || ! defined $exitObj || ! defined $exitMode
|| ! defined $ornamentsFlag || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawBentExit', @_);
}
# Set the canvas widget on which the room is drawn, if not already set
if (! $canvasWidget) {
$canvasWidget = $self->drawParchment->ivShow('canvasWidgetHash', $roomObj->zPosBlocks);
}
# For one-way exits, if the destination room has an exit drawn in the primary used by
# $exitObj->oneWayDir, then we draw the exit as a normal one-way exit (which will be
# confined to its own gridblock, to avoid overlapping the destination room's opposite
# exit)
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->destRoom);
if ($exitObj->oneWayFlag && $destRoomObj->ivExists('exitNumHash', $exitObj->oneWayDir)) {
return $self->drawOneWayExit($roomObj, $exitObj, $ornamentsFlag, $canvasWidget);
# For uncertain exits, draw the exit as a normal uncertain exit
} elsif (! $exitObj->oneWayFlag && ! $twinExitObj) {
return $self->drawUncertainExit($roomObj, $exitObj, $ornamentsFlag, $canvasWidget);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Decide which colour to use
$colour = $self->getExitColour($exitObj);
# Compile a list of points in the form (x, y, x, y...) which mark the start and finish,
# and the intermediate bends, of a bent exit
# The first section of a bent exit consists of the line that would be drawn as an
# uncertain exit. $posnListRef is a reference to a list in the form
# (startx, starty, stopx, stopy)
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $mapDir);
push (@pointList,
($xPos + $$posnListRef[0]),
($yPos + $$posnListRef[1]),
($xPos + $$posnListRef[2]),
($yPos + $$posnListRef[3]),
);
# The middle section of a bent exit consists of a list of points, starting at the end of
# the hypothetical uncertain exit. If there are no bends marked in the exit's
# ->bendOffsetList (after being added by the user), then nothing is added to
# @offsetList here
if ($exitObj->bendOffsetList) {
@offsetList = $exitObj->bendOffsetList;
do {
my ($offsetXPos, $offsetYPos);
$offsetXPos = (shift @offsetList) + $xPos + $$posnListRef[2];
$offsetYPos = (shift @offsetList) + $yPos + $$posnListRef[3];
push (@pointList, $offsetXPos, $offsetYPos);
} until (! @offsetList);
}
# The final section of a bent exit consists of a line that would be drawn as an
# uncertain exit at the destination room
# If $exitObj has a twin exit that's drawn in a cardinal direction, that's the uncertain
# exit whose line we use.
# If $exitObj is a one-way exit, we use the uncertain exit specified by its
# ->oneWayDir (which is the opposite of ->mapDir, by default, but this can be changed
# by the user)
# Otherwise, we use the uncertain exit in the opposite direction that $exitObj is drawn
# (e.g. west - east)
$destXPos = $destRoomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$destYPos = $destRoomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
if ($twinExitObj) {
$posnListRef2 = $self->ivShow('preDrawnUncertainExitHash', $twinExitObj->mapDir);
} elsif (
$exitObj->oneWayFlag
# (->preDrawnUncertainExitHash doesn't contain 'up' and 'down')
&& $self->ivExists('preDrawnUncertainExitHash', $exitObj->oneWayDir)
) {
$posnListRef2 = $self->ivShow('preDrawnUncertainExitHash', $exitObj->oneWayDir);
} else {
$posnListRef2 = $self->ivShow(
'preDrawnUncertainExitHash',
$axmud::CLIENT->ivShow('constOppDirHash', $exitObj->mapDir),
);
}
push (@pointList,
($destXPos + $$posnListRef2[2]),
($destYPos + $$posnListRef2[3]),
($destXPos + $$posnListRef2[0]),
($destYPos + $$posnListRef2[1]),
);
if ($twinExitObj && $exitMode eq 'complex_exit') {
# Draw a two-way bent exit in complex exits mode (only)
# First and middle section
# Find the exit's vector - a reference to a list of 3d coordinates, (x, y, z)
# e.g. northeast > (1, 1, 0)
$vectorRef = $self->ivShow('constVectorHash', $mapDir);
# Find the exit's double vector - a reference to a list of 3d coordinates,
# (x1, y1, x2, y2) which we add to the start and stop pixels of what would have
# been a single line, to produce two parallel lines either side of it
$doubleVectorRef = $self->ivShow('constDoubleVectorHash', $mapDir);
# Convert the list of coordinates in @pointList, representing a bent exit drawn as
# a single line, into two lists of coordinates, @pointList2 and @pointList3,
# representing a bent exit drawn as two parallel lines
# Don't do anything to the last four values in @pointList (which represent the end
# section) yet
for (my $count = 0; $count < ((scalar @pointList) - 4); $count += 2) {
push (@pointList2, $pointList[$count] + $$doubleVectorRef[0]);
push (@pointList2, $pointList[$count + 1] + $$doubleVectorRef[1]);
push (@pointList3, $pointList[$count] + $$doubleVectorRef[2]);
push (@pointList3, $pointList[$count + 1] + $$doubleVectorRef[3]);
}
# End section
# Find the exit's vector - a reference to a list of 3d coordinates, (x, y, z)
# e.g. northeast > (1, 1, 0)
$vectorRef = $self->ivShow('constVectorHash', $twinExitObj->mapDir);
# Find the exit's double vector - a reference to a list of 3d coordinates,
# (x1, y1, x2, y2) which we add to the start and stop pixels of what would have
# been a single line, to produce two parallel lines either side of it
$doubleVectorRef = $self->ivShow('constDoubleVectorHash', $twinExitObj->mapDir);
# Convert the list of coordinates in @pointList, representing a bent exit drawn as
# a single line, into two lists of coordinates, @pointList2 and @pointList3,
# representing a bent exit drawn as two parallel lines
# Don't do anything to the last four values in @pointList (which represent the end
# section) yet
for (
my $count = ((scalar @pointList) - 4);
$count < scalar @pointList;
$count += 2
) {
push (@pointList2, $pointList[$count] + $$doubleVectorRef[0]);
push (@pointList2, $pointList[$count + 1] + $$doubleVectorRef[1]);
push (@pointList3, $pointList[$count] + $$doubleVectorRef[2]);
push (@pointList3, $pointList[$count + 1] + $$doubleVectorRef[3]);
}
# For diagonal two-way exits, we have a small problem
# We need to increase the length of each of the two lines by two pixels, to
# compensate for the fact that each line is being drawn 2 pixels closer to one of
# the rooms (and one pixel further away from the others)
# When the exit is diagonal, $$vectorRef[0] and $$vectorRef[1] both equal either 2
# or -2
if ($$vectorRef[0] && $$vectorRef[1] && ! $$vectorRef[2]) {
$pointList2[-2] += ($$vectorRef[0] * 2);
$pointList2[-1] += ($$vectorRef[1] * 2);
$pointList3[-2] += ($$vectorRef[0] * 2);
$pointList3[-1] += ($$vectorRef[1] * 2);
}
# Depending on the relative positions of the two twinned exits, and the positions
# of any bends between them, the two parallel may intersect and cross over each
# other
# Eliminate these intersections by reversing the positions of corresponding points
# in @pointList2 and @pointList3, as necessary
($listRef2, $listRef3) = $self->reverseIntersectingLines(
\@pointList2,
\@pointList3,
);
# Convert the lists to the format GooCanvas2::CanvasPath expects
$points = 'M ' . (shift @$listRef2) . ' ' . (shift @$listRef2);
do {
$points .= ' L ' . (shift @$listRef2) . ' ' . (shift @$listRef2);
} until (! @$listRef2);
$points .= ' M ' . (shift @$listRef3) . ' ' . (shift @$listRef3);
do {
$points .= ' L ' . (shift @$listRef3) . ' ' . (shift @$listRef3);
} until (! @$listRef3);
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' => $points,
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handlers for the canvas objects
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object later in the function
push (@canvasObjList, $newObj);
} else {
# Draw a one-way exit in simple/complex exits mode, or a two-way exit in simple
# exits mode
# Convert the lists to the format GooCanvas2::CanvasPath expects
$points = 'M ' . (shift @pointList) . ' ' . (shift @pointList);
do {
$points .= ' L ' . (shift @pointList) . ' ' . (shift @pointList);
} until (! @pointList);
# Add the arrow head
$points .= $self->prepareArrowHead($exitObj, $xPos, $yPos, $posnListRef);
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' => $points,
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object later in the function
push (@canvasObjList, $newObj);
}
# For a selected exit, draw a square at each bend
if (
$exitObj->bendOffsetList
&& (
(
($self->selectedExit && $self->selectedExit eq $exitObj)
|| ($self->ivExists('selectedExitHash', $exitObj->number))
) || (
$twinExitObj
&& (
($self->selectedExit && $self->selectedExit eq $twinExitObj)
|| ($self->ivExists('selectedExitHash', $twinExitObj->number))
)
)
)
) {
@offsetList = $exitObj->bendOffsetList;
$bendSize = $self->exitBendSize; # Default 4
do {
my ($offsetXPos, $offsetYPos, $bendObj);
$offsetXPos = (shift @offsetList) + $$posnListRef[2];
$offsetYPos = (shift @offsetList) + $$posnListRef[3];
# Draw the canvas object
$bendObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $xPos + $offsetXPos - ($bendSize / 2),
'y' => $yPos + $offsetYPos - ($bendSize / 2),
'width' => $bendSize,
'height' => $bendSize,
'line-width' => 0,
# 'stroke-color' => $colour,
'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $bendObj, $exitObj);
push (@canvasObjList, $bendObj);
} until (! @offsetList);
}
# Store the canvas objects together
$self->drawParchment->addDrawnExit($roomObj, $exitObj, \@canvasObjList);
# Draw ornaments for this exit and/or the twin exit, if there are any (and if allowed)
if ($ornamentsFlag) {
if (
$exitObj->exitOrnament ne 'none'
|| ($twinExitObj && $twinExitObj->exitOrnament ne 'none')
) {
$self->drawExitOrnaments(
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
$twinExitObj,
$destXPos,
$destYPos,
);
}
}
}
return 1;
}
sub drawDraggableExit {
# Called by $self->startDrag and ->continueDrag to draw a draggable exit
#
# Expected arguments
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $mouseXPos, $mouseYPos
# - The position on the map of the end of the exit (the current position of
# the user's mouse)
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# Otherwise, returns the canvas object drawn
my ($self, $exitObj, $mouseXPos, $mouseYPos, $check) = @_;
# Local variables
my ($mapDir, $roomObj, $xPos, $yPos, $posnListRef, $points, $canvasWidget, $newObj);
# Check for improper arguments
if (! defined $exitObj || ! defined $mouseXPos || ! defined $mouseYPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawDraggableExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Get the position of the parent room's gridblock
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
$xPos = $roomObj->xPosBlocks * $self->currentRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->currentRegionmap->blockHeightPixels;
# Compile a list of points in the form (x, y, x, y...) which mark the start and finish,
# and the intermediate bends, of a bent exit
# The first section of a draggable exit consists of the line that would be drawn as an
# uncertain exit. $posnListRef is a reference to a list in the form (startx, starty,
# stopx, stopy)
# The middle section of a draggable exit leads from the end of the hypothetical uncertain
# exit, to the current mouse position
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $mapDir);
$points =
'M ' . ($xPos + $$posnListRef[0])
. ' ' . ($yPos + $$posnListRef[1])
. ' L ' . ($xPos + $$posnListRef[2])
. ' ' . ($yPos + $$posnListRef[3])
. ' L ' . $mouseXPos
. ' ' . $mouseYPos;
# Draw the canvas object
$canvasWidget = $self->currentParchment->ivShow(
'canvasWidgetHash',
$self->currentRegionmap->currentLevel,
);
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' => $points,
# 'line-width' => 2,
'stroke-color' => $self->drawScheme->dragExitColour,
# 'fill-color' => $self->drawScheme->dragExitColour,
);
# Set the object's position in the canvas drawing stack
$newObj->raise();
# Set up the event handlers for the canvas objects
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
return $newObj;
}
sub drawBrokenExit {
# Called by $self->drawExit to draw an exit that leads to another room at an arbitrary
# position in this region (and not necessarily on the same level). 'Normal' broken exits
# are drawn as a filled-in square
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $canvasWidget, $check) = @_;
# Local variables
my ($mapDir, $posnListRef, $colour, $xPos, $yPos, $newObj, $levelObj);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $canvasWidget || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawBrokenExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Find the exit's position
$posnListRef = $self->ivShow('preDrawnSquareExitHash', $mapDir);
# Decide which colour to use
$colour = $self->getExitColour($exitObj);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw the canvas object
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $xPos + $$posnListRef[0],
'y' => $yPos + $$posnListRef[3],
'width' => $$posnListRef[2] - $$posnListRef[0],
'height' => $$posnListRef[1] - $$posnListRef[3],
'line-width' => 0,
# 'stroke-color' => $colour,
'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
}
return 1;
}
sub drawRegionExit {
# Called by $self->drawExit to draw an exit that leads to another room in a different region
# - currently drawn as an unfilled-in square
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $canvasWidget, $check) = @_;
# Local variables
my ($mapDir, $posnListRef, $xPos, $yPos, $newObj, $levelObj);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $canvasWidget || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRegionExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Find the exit's position
$posnListRef = $self->ivShow('preDrawnSquareExitHash', $mapDir);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Draw the canvas object
$newObj = GooCanvas2::CanvasRect->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $xPos + $$posnListRef[0],
'y' => $yPos + $$posnListRef[3],
'width' => $$posnListRef[2] - $$posnListRef[0],
'height' => $$posnListRef[1] - $$posnListRef[3],
'line-width' => 1,
'stroke-color' => $self->getExitColour($exitObj),
# 'fill-color' => $self->getExitColour($exitObj),
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
}
return 1;
}
sub drawRandomExit {
# Called by $self->drawExit to draw an exit that leads to a random location
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $canvasWidget, $check) = @_;
# Local variables
my (
$mapDir, $posnListRef, $xPos, $yPos, $colour, $outlineColour, $fillColour, $newObj,
$levelObj,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRandomExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Find the exit's position
$posnListRef = $self->ivShow('preDrawnSquareExitHash', $mapDir);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Set the exit colour
$colour = $self->getExitColour($exitObj);
# Some types of random exits are filled in
if ($colour ne $self->drawScheme->exitColour) {
# Exit is probably selected; use that colour rather than a random exit colour
$outlineColour = $fillColour = $colour;
} elsif ($exitObj->randomType eq 'same_region') {
# Default - black circle
$outlineColour = $fillColour = $colour;
} elsif ($exitObj->randomType eq 'any_region') {
# Default - red circle
$outlineColour = $fillColour = $self->drawScheme->randomExitColour;
} elsif ($exitObj->randomType eq 'temp_region') {
# Default - black circle with transparent centre
$outlineColour = $colour;
$fillColour = $self->drawScheme->backgroundColour;
} else {
# Default for 'room_list' - red circle with transparent centre
$outlineColour = $self->drawScheme->randomExitColour;
$fillColour = $self->drawScheme->backgroundColour;
}
# Draw the canvas object
$newObj = GooCanvas2::CanvasEllipse->new(
'parent' => $canvasWidget->get_root_item(),
'x' => $xPos + $$posnListRef[0],
'y' => $yPos + $$posnListRef[3],
'width' => abs($$posnListRef[2] - $$posnListRef[0]),
'height' => abs($$posnListRef[1] - $$posnListRef[3]),
# 'line-width' => 2,
'stroke-color' => $outlineColour,
'fill-color' => $fillColour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
}
return 1;
}
sub drawRetracingExit {
# Called by $self->drawExit to draw an exit that leads back to the same room (drawn as a
# triangle)
#
# Expected arguments
# $roomObj - Blessed reference of the parent GA::ModelObj::Room
# $exitObj - Blessed reference of the GA::Obj::Exit being drawn
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
#
# Return values
# 'undef' on improper arguments or if the exit can't be drawn
# 1 otherwise
my ($self, $roomObj, $exitObj, $canvasWidget, $check) = @_;
# Local variables
my (
$mapDir, $lineListRef, $squareListRef, $triangleListRef, $xPos, $yPos, $colour, $newObj,
$levelObj,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $canvasWidget || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawRetracingExit', @_);
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return undef;
}
# Draw 'up' and 'down' - the letters 'U' and 'D' in the bottom corners of the room
if ($mapDir eq 'up' || $mapDir eq 'down') {
$self->drawUpDown($roomObj, $exitObj, $canvasWidget);
# Draw cardinal directions (the sixteen primary directions which aren't 'up' and 'down')
} else {
# Find the position of an incomplete exit. The first two values in the list, which is
# the point at which the exit meets the room, give us the coordinates of a triangle
# corner
$lineListRef = $self->ivShow('preDrawnIncompleteExitHash', $mapDir);
# Find the position of a broken or region exit. Two of the corners are used as the
# remaining corners in the triangle
$squareListRef = $self->ivShow('preDrawnSquareExitHash', $mapDir);
# Make sure the four elements in @$squareListRef are in the order
# (top_left_x, top_left_y, bottom_right_x, bottom_right_y)
if ($$squareListRef[0] > $$squareListRef[2]) {
($$squareListRef[0], $$squareListRef[2]) = ($$squareListRef[2], $$squareListRef[0]);
}
if ($$squareListRef[1] > $$squareListRef[3]) {
($$squareListRef[1], $$squareListRef[3]) = ($$squareListRef[3], $$squareListRef[1]);
}
# $self->constTriangleCornerHash tells us which of the square's four corners to use
$triangleListRef = $self->ivShow('constTriangleCornerHash', $mapDir);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->drawRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->drawRegionmap->blockHeightPixels;
# Set the exit colour
$colour = $self->getExitColour($exitObj);
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
# Triangle corner nearest the room
'M ' . ($xPos + $$lineListRef[0])
. ' ' . ($yPos + $$lineListRef[1])
# Second triangle corner
. ' L ' . ($xPos + $$squareListRef[$$triangleListRef[0]])
. ' ' . ($yPos + $$squareListRef[$$triangleListRef[1]])
# Third triangle corner
. ' L ' . ($xPos + $$squareListRef[$$triangleListRef[2]])
. ' ' . ($yPos + $$squareListRef[$$triangleListRef[3]])
# Back to the beginning
. ' L ' . ($xPos + $$lineListRef[0])
. ' ' . ($yPos + $$lineListRef[1]),
# 'line-width' => 2,
'stroke-color' => $colour,
'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $exitObj);
# Store the canvas object
$self->drawParchment->addDrawnExit($roomObj, $exitObj, [$newObj]);
}
return 1;
}
sub drawExitOrnaments {
# Called by $self->drawOneWayExit, etc
# Checks the ornament flags for a GA::Obj::Exit and/or its twin GA::Obj::Exit and,
# depending on which ornaments need to be drawn, calls the relevant functions
# (NB Impassable/mystery exits have their exit ornament drawn by ->drawImpassableExit at the
# same time as the exit is drawn)
#
# Expected arguments
# $exitObj - The GA::Obj::Exit being drawn in a drawing cycle initiated by
# $self->doDraw
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $colour - The colour in which the whole exit is being drawn
# $xPos, $yPos - Coordinates of the gridblock occupied by GA::Obj::Exit's parent room
#
# Optional arguments
# $twinExitObj - The blessed reference of the twin GA::Obj::Exit, if there is one
# (otherwise set to 'undef')
# $destXPos, $destYPos
# - Coordinates of the gridblock occupied by the destination room
# ('undef' if $exitObj is an incomplete or uncertain exit)
# $posnListRef - For incomplete and uncertain exits, a reference to a list defining the
# position of the exit actually drawn. The ornament is drawn at the
# centre of the line. (Otherwise set to 'undef', and the ornament is
# drawn at the centre of a hypothetical uncertain exit)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my (
$self, $exitObj, $canvasWidget, $colour, $xPos, $yPos, $twinExitObj, $destXPos,
$destYPos, $posnListRef, $check,
) = @_;
# Check for improper arguments
if (
! defined $exitObj || ! defined $canvasWidget || ! defined $colour || ! defined $xPos
|| ! defined $yPos || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawExitOrnaments', @_);
}
# Draw an ornament for $exitObj (if this GA::Obj::Exit has an ornament)
if ($exitObj->exitOrnament ne 'none') {
if ($exitObj->exitOrnament eq 'break') {
$self->drawBreakableOrnament(
$exitObj,
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
$posnListRef,
);
} elsif ($exitObj->exitOrnament eq 'pick') {
$self->drawPickableOrnament(
$exitObj,
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
$posnListRef,
);
} elsif ($exitObj->exitOrnament eq 'lock') {
$self->drawLockableOrnament(
$exitObj,
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
$posnListRef,
);
} elsif ($exitObj->exitOrnament eq 'open') {
$self->drawOpenableOrnament(
$exitObj,
$exitObj,
$canvasWidget,
$colour,
$xPos,
$yPos,
$posnListRef,
);
}
}
# Draw an ornament for $twinExitObj (if this GA::Obj::Exit has an ornament)
if ($twinExitObj && $twinExitObj->exitOrnament ne 'none') {
if ($twinExitObj->exitOrnament eq 'break') {
$self->drawBreakableOrnament(
$twinExitObj,
$exitObj,
$canvasWidget,
$colour,
$destXPos,
$destYPos,
$posnListRef,
);
} elsif ($twinExitObj->exitOrnament eq 'pick') {
$self->drawPickableOrnament(
$twinExitObj,
$exitObj,
$canvasWidget,
$colour,
$destXPos,
$destYPos,
$posnListRef,
);
} elsif ($twinExitObj->exitOrnament eq 'lock') {
$self->drawLockableOrnament(
$twinExitObj,
$exitObj,
$canvasWidget,
$colour,
$destXPos,
$destYPos,
$posnListRef,
);
} elsif ($twinExitObj->exitOrnament eq 'open') {
$self->drawOpenableOrnament(
$twinExitObj,
$exitObj,
$canvasWidget,
$colour,
$destXPos,
$destYPos,
$posnListRef,
);
}
}
return 1;
}
sub drawBreakableOrnament {
# Called by $self->drawExitOrnaments
# Draws an exit ornament that shows the exit is breakable
#
# Expected arguments
# $parentObj - The GA::Obj::Exit to which this ornament belongs
# $drawObj - The GA::Obj::Exit which is actually being drawn in the current draw
# cycle (initiated after a call to $self->doDraw). An exit and its
# twin exit are drawn as a single object; if we're drawing an ornament
# for an exit, $parentObj and $drawObj will be the same, but if we're
# drawing an ornament for the twin, $drawObj will be the exit and
# $parentObj will be the twin
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $colour - The colour in which the whole exit is being drawn
# $xPos, $yPos - Coordinates of the gridblock occupied by the parent room of the
# GA::Obj::Exit whose ornament is being drawn (i.e. $parentObj)
#
# Optional arguments
# $posnListRef - For incomplete and uncertain exits, a reference to list defining the
# position of the exit actually drawn. The ornament is drawn at the
# centre of the line. (Otherwise set to 'undef', and the ornament is
# drawn at the centre of a hypothetical uncertain exit)
#
# Return values
# 'undef' on improper arguments or if the ornament can't be drawn
# 1 otherwise
my (
$self, $parentObj, $drawObj, $canvasWidget, $colour, $xPos, $yPos, $posnListRef, $check,
) = @_;
# Local variables
my (
$exitMiddleXPosPixels, $exitMiddleYPosPixels, $vectorRef, $perpVectorRef,
$perpStartXPosPixels, $perpStartYPosPixels, $perpStopXPosPixels, $perpStopYPosPixels,
$startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels, $newObj, $newObj2,
$roomObj, $levelObj,
@polygonList,
);
# Check for improper arguments
if (
! defined $parentObj || ! defined $drawObj || ! defined $canvasWidget
|| ! defined $colour || ! defined $xPos || ! defined $yPos || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawBreakableOrnament', @_);
}
if (! defined $posnListRef) {
if (! $parentObj->mapDir) {
# (Almost certainly an unallocatable exit)
return undef;
}
# An uncertain exit would be drawn from the edge of the room to the edge of the
# gridblock. The exit ornament is drawn in the middle of this hypothetical line. Find
# the position of the line
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $parentObj->mapDir);
}
# Get the coordinates at the pixel in the middle of this hypothetical line
($exitMiddleXPosPixels, $exitMiddleYPosPixels) = $self->findExitMiddle(
($$posnListRef[0] + $xPos), ($$posnListRef[1] + $yPos),
($$posnListRef[2] + $xPos), ($$posnListRef[3] + $yPos),
);
# Get the vector of the exit line
$vectorRef = $self->ivShow('constVectorHash', $parentObj->mapDir);
# Get the vector of the perpendicular to the exit line
$perpVectorRef = $self->ivShow('constPerpVectorHash', $parentObj->mapDir);
# The ornament is made of up one line drawn perpendicular to the exit, with two smaller
# lines at each end of this perpendicular, running parallel with the exit line - in other
# words:
#
# XXX X - Ornament
# X e - Exit line
# eeeeeeeXeeeeeee
# X
# XXX
#
# The perpendicular is exactly the same as the line drawn in an openable ornament
# The two smaller lines are opposite sides of the polygon drawn in a pickable ornament
# Find the ends of each half of the perpendicular line
$perpStartXPosPixels = $exitMiddleXPosPixels + (
$$perpVectorRef[0] * int(
($self->drawRegionmap->blockWidthPixels
- $self->drawRegionmap->roomWidthPixels
) / 3
)
);
$perpStartYPosPixels = $exitMiddleYPosPixels + (
$$perpVectorRef[1] * int(
($self->drawRegionmap->blockHeightPixels
- $self->drawRegionmap->roomHeightPixels
) / 3
)
);
$perpStopXPosPixels = $exitMiddleXPosPixels + (
$$perpVectorRef[2] * int(
($self->drawRegionmap->blockWidthPixels
- $self->drawRegionmap->roomWidthPixels
) / 3
)
);
$perpStopYPosPixels = $exitMiddleYPosPixels + (
$$perpVectorRef[3] * int(
($self->drawRegionmap->blockHeightPixels
- $self->drawRegionmap->roomHeightPixels
) / 3
)
);
# Now get the vertices of the polygon that would have been drawn in a pickable
# ornament
push (@polygonList, $self->findPerpendicular(
$vectorRef,
$perpVectorRef,
-1,
$exitMiddleXPosPixels,
$exitMiddleYPosPixels,
$self->drawRegionmap,
)
);
($startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels)
= $self->findPerpendicular(
$vectorRef,
$perpVectorRef,
1,
$exitMiddleXPosPixels,
$exitMiddleYPosPixels,
$self->drawRegionmap,
);
push (@polygonList, $stopXPosPixels, $stopYPosPixels, $startXPosPixels, $startYPosPixels);
# Draw the canvas objects. Draw two objects rather than one, so their widths can be
# different
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($perpStartXPosPixels) . ' ' . ($perpStartYPosPixels)
. ' L ' . ($perpStopXPosPixels) . ' ' . ($perpStopYPosPixels),
'line-width' => 1,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
$newObj2 = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($polygonList[0]) . ' ' . ($polygonList[1])
. ' L ' . ($polygonList[6]) . ' ' . ($polygonList[7])
. 'M ' . ($polygonList[2]) . ' ' . ($polygonList[3])
. ' L ' . ($polygonList[4]) . ' ' . ($polygonList[5]),
# 'line-width' => 2,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the objects' position in the canvas drawing stack
$roomObj = $self->worldModelObj->ivShow('modelHash', $drawObj->parent);
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
$newObj2->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
$newObj2->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas objects
$self->setupCanvasObjEvent('exit', $newObj, $drawObj);
$self->setupCanvasObjEvent('exit', $newObj2, $drawObj);
# Store the canvas objects
$self->drawParchment->addDrawnOrnament(
$roomObj,
$drawObj,
[$newObj, $newObj2],
);
return 1;
}
sub drawPickableOrnament {
# Called by $self->drawExitOrnaments
# Draws an exit ornament that shows the exit is pickable
#
# Expected arguments
# $parentObj - The GA::Obj::Exit to which this ornament belongs
# $drawObj - The GA::Obj::Exit which is actually being drawn in the current draw
# cycle (initiated after a call to $self->doDraw). An exit and its
# twin exit are drawn as a single object; if we're drawing an ornament
# for an exit, $parentObj and $drawObj will be the same, but if we're
# drawing an ornament for the twin, $drawObj will be the exit and
# $parentObj will be the twin
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $colour - The colour in which the whole exit is being drawn
# $xPos, $yPos - Coordinates of the gridblock occupied by the parent room of the
# GA::Obj::Exit whose ornament is being drawn (i.e. $parentObj)
#
# Optional arguments
# $posnListRef - For incomplete and uncertain exits, a reference to list defining the
# position of the exit actually drawn. The ornament is drawn at the
# centre of the line. (Otherwise set to 'undef', and the ornament is
# drawn at the centre of a hypothetical uncertain exit)
#
# Return values
# 'undef' on improper arguments or if the ornament can't be drawn
# 1 otherwise
my (
$self, $parentObj, $drawObj, $canvasWidget, $colour, $xPos, $yPos, $posnListRef, $check,
) = @_;
# Local variables
my (
$exitMiddleXPosPixels, $exitMiddleYPosPixels, $vectorRef, $perpVectorRef,
$startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels, $points, $newObj,
$roomObj, $levelObj,
@polygonList,
);
# Check for improper arguments
if (
! defined $parentObj || ! defined $drawObj || ! defined $canvasWidget
|| ! defined $colour || ! defined $xPos || ! defined $yPos || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawPickableOrnament', @_);
}
if (! defined $posnListRef) {
if (! $parentObj->mapDir) {
# (Almost certainly an unallocatable exit)
return undef;
}
# An uncertain exit would be drawn from the edge of the room to the edge of the
# gridblock. The exit ornament is drawn in the middle of this hypothetical line. Find
# the position of the line
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $parentObj->mapDir);
}
# Get the coordinates at the pixel in the middle of the hypothetical line
($exitMiddleXPosPixels, $exitMiddleYPosPixels) = $self->findExitMiddle(
($$posnListRef[0] + $xPos), ($$posnListRef[1] + $yPos),
($$posnListRef[2] + $xPos), ($$posnListRef[3] + $yPos),
);
# Get the vector of the exit line
$vectorRef = $self->ivShow('constVectorHash', $parentObj->mapDir);
# Get the vector of the perpendicular to the exit line
$perpVectorRef = $self->ivShow('constPerpVectorHash', $parentObj->mapDir);
# The ornament is made up of two lines running parallel to each other, which is then drawn
# as a polygon (actually a series of lines, each ending where the previous one stopped)
# Call ->findPerpendicular to find the coordinates of both ends of each line, and store them
# in @polygonList - a sequential list of coordinates of the vertices of the polygon,
# i.e. (x, y, x, y, ...)
push (@polygonList, $self->findPerpendicular(
$vectorRef,
$perpVectorRef,
-1,
$exitMiddleXPosPixels,
$exitMiddleYPosPixels,
$self->drawRegionmap,
)
);
($startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels)
= $self->findPerpendicular(
$vectorRef,
$perpVectorRef,
1,
$exitMiddleXPosPixels,
$exitMiddleYPosPixels,
$self->drawRegionmap,
);
push (@polygonList, $stopXPosPixels, $stopYPosPixels, $startXPosPixels, $startYPosPixels);
# The first pixel in the list must be added again at the end, in order to complete the
# polygon
push (@polygonList, $polygonList[0], $polygonList[1]);
# Draw the canvas object
$points = 'M ' . (shift @polygonList) . ' ' . shift (@polygonList);
do {
$points .= ' L ' . (shift @polygonList) . ' ' . shift (@polygonList);
} until (! @polygonList);
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' => $points,
'line-width' => 1,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$roomObj = $self->worldModelObj->ivShow('modelHash', $drawObj->parent);
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $drawObj);
# Store the canvas object
$self->drawParchment->addDrawnOrnament($roomObj, $drawObj, [$newObj]);
return 1;
}
sub drawLockableOrnament {
# Called by $self->drawExitOrnaments
# Draws an exit ornament that shows the exit is lockable (like a door)
#
# Expected arguments
# $parentObj - The GA::Obj::Exit to which this ornament belongs
# $drawObj - The GA::Obj::Exit which is actually being drawn in the current draw
# cycle (initiated after a call to $self->doDraw). An exit and its
# twin exit are drawn as a single object; if we're drawing an ornament
# for an exit, $parentObj and $drawObj will be the same, but if we're
# drawing an ornament for the twin, $drawObj will be the exit and
# $parentObj will be the twin
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $colour - The colour in which the whole exit is being drawn
# $xPos, $yPos - Coordinates of the gridblock occupied by the parent room of the
# GA::Obj::Exit whose ornament is being drawn (i.e. $parentObj)
#
# Optional arguments
# $posnListRef - For incomplete and uncertain exits, a reference to list defining the
# position of the exit actually drawn. The ornament is drawn at the
# centre of the line. (Otherwise set to 'undef', and the ornament is
# drawn at the centre of a hypothetical uncertain exit)
#
# Return values
# 'undef' on improper arguments or if the ornament can't be drawn
# 1 otherwise
my (
$self, $parentObj, $drawObj, $canvasWidget, $colour, $xPos, $yPos, $posnListRef, $check,
) = @_;
# Local variables
my (
$exitMiddleXPosPixels, $exitMiddleYPosPixels, $vectorRef, $perpVectorRef,
$perpStartXPosPixels, $perpStartYPosPixels, $perpStopXPosPixels, $perpStopYPosPixels,
$points, $newObj, $roomObj, $levelObj,
@factorList,
);
# Check for improper arguments
if (
! defined $parentObj || ! defined $drawObj || ! defined $canvasWidget
|| ! defined $colour || ! defined $xPos || ! defined $yPos || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawLockableOrnament', @_);
}
if (! defined $posnListRef) {
if (! $parentObj->mapDir) {
# (Almost certainly an unallocatable exit)
return undef;
}
# An uncertain exit would be drawn from the edge of the room to the edge of the
# gridblock. The exit ornament is drawn in the middle of this hypothetical line. Find
# the position of the line
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $parentObj->mapDir);
}
# Get the coordinates at the pixel in the middle of the exit line
($exitMiddleXPosPixels, $exitMiddleYPosPixels) = $self->findExitMiddle(
($$posnListRef[0] + $xPos), ($$posnListRef[1] + $yPos),
($$posnListRef[2] + $xPos), ($$posnListRef[3] + $yPos),
);
# Get the vector of the exit line, and the vector of the opposite direction
$vectorRef = $self->ivShow('constVectorHash', $parentObj->mapDir);
# Get the vector of the perpendicular to the exit line
$perpVectorRef = $self->ivShow('constPerpVectorHash', $parentObj->mapDir);
# The ornament is made up of two lines running parallel to each other, and both
# perpendicular to the exit line
@factorList = (-1, 1);
# Draw each line in turn, one pixel apart
foreach my $factor (@factorList) {
($perpStartXPosPixels, $perpStartYPosPixels, $perpStopXPosPixels, $perpStopYPosPixels)
= $self->findPerpendicular(
$vectorRef,
$perpVectorRef,
$factor,
$exitMiddleXPosPixels,
$exitMiddleYPosPixels,
$self->drawRegionmap,
);
$points .= ' M ' . $perpStartXPosPixels
. ' ' . $perpStartYPosPixels
. ' L ' . $perpStopXPosPixels
. ' ' . $perpStopYPosPixels;
}
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' => $points,
'line-width' => 1,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$roomObj = $self->worldModelObj->ivShow('modelHash', $drawObj->parent);
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $drawObj);
# Store the canvas objects
$self->drawParchment->addDrawnOrnament($roomObj, $drawObj, [$newObj]);
return 1;
}
sub drawOpenableOrnament {
# Called by $self->drawExitOrnaments
# Draws an exit ornament that shows the exit is openable (like a door)
#
# Expected arguments
# $parentObj - The GA::Obj::Exit to which this ornament belongs
# $drawObj - The GA::Obj::Exit which is actually being drawn in the current draw
# cycle (initiated after a call to $self->doDraw). An exit and its
# twin exit are drawn as a single object; if we're drawing an ornament
# for an exit, $parentObj and $drawObj will be the same, but if we're
# drawing an ornament for the twin, $drawObj will be the exit and
# $parentObj will be the twin
# $canvasWidget - The canvas widget (GooCanvas2::Canvas) on which the room is drawn
# $colour - The colour in which the whole exit is being drawn
# $xPos, $yPos - Coordinates of the gridblock occupied by the parent room of the
# GA::Obj::Exit whose ornament is being drawn (i.e. $parentObj)
#
# Optional arguments
# $posnListRef - For incomplete and uncertain exits, a reference to list defining the
# position of the exit actually drawn. The ornament is drawn at the
# centre of the line. (Otherwise set to 'undef', and the ornament is
# drawn at the centre of a hypothetical uncertain exit)
#
# Return values
# 'undef' on improper arguments, or if the ornament can't be drawn
# 1 otherwise
my (
$self, $parentObj, $drawObj, $canvasWidget, $colour, $xPos, $yPos, $posnListRef,
$check,
) = @_;
# Local variables
my (
$exitMiddleXPosPixels, $exitMiddleYPosPixels, $perpVectorRef, $perpStartXPosPixels,
$perpStartYPosPixels, $perpStopXPosPixels, $perpStopYPosPixels, $newObj, $roomObj,
$levelObj,
);
# Check for improper arguments
if (
! defined $parentObj || ! defined $drawObj || ! defined $canvasWidget
|| ! defined $colour || ! defined $xPos || ! defined $yPos || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->drawOpenableOrnament', @_);
}
if (! defined $posnListRef) {
if (! $parentObj->mapDir) {
# (Almost certainly an unallocatable exit)
return undef;
}
# An uncertain exit would be drawn from the edge of the room to the edge of the
# gridblock. The exit ornament is drawn in the middle of this hypothetical line. Find
# the position of the line
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $parentObj->mapDir);
}
# Get the coordinates at the pixel in the middle of this hypothetical line
($exitMiddleXPosPixels, $exitMiddleYPosPixels) = $self->findExitMiddle(
($$posnListRef[0] + $xPos), ($$posnListRef[1] + $yPos),
($$posnListRef[2] + $xPos), ($$posnListRef[3] + $yPos),
);
# Get the vector of the perpendicular to the exit line
$perpVectorRef = $self->ivShow('constPerpVectorHash', $parentObj->mapDir);
# Find the ends of each half of the perpendicular line
$perpStartXPosPixels = $exitMiddleXPosPixels + (
$$perpVectorRef[0] * int(
($self->drawRegionmap->blockWidthPixels
- $self->drawRegionmap->roomWidthPixels
) / 3
)
);
$perpStartYPosPixels = $exitMiddleYPosPixels + (
$$perpVectorRef[1] * int(
($self->drawRegionmap->blockHeightPixels
- $self->drawRegionmap->roomHeightPixels
) / 3
)
);
$perpStopXPosPixels = $exitMiddleXPosPixels + (
$$perpVectorRef[2] * int(
($self->drawRegionmap->blockWidthPixels
- $self->drawRegionmap->roomWidthPixels
) / 3
)
);
$perpStopYPosPixels = $exitMiddleYPosPixels + (
$$perpVectorRef[3] * int(
($self->drawRegionmap->blockHeightPixels
- $self->drawRegionmap->roomHeightPixels
) / 3
)
);
# Draw the canvas object
$newObj = GooCanvas2::CanvasPath->new(
'parent' => $canvasWidget->get_root_item(),
'data' =>
'M ' . ($perpStartXPosPixels) . ' ' . ($perpStartYPosPixels)
. ' L ' . ($perpStopXPosPixels) . ' ' . ($perpStopYPosPixels),
'line-width' => 1,
'stroke-color' => $colour,
# 'fill-color' => $colour,
);
# Set the object's position in the canvas drawing stack
$roomObj = $self->worldModelObj->ivShow('modelHash', $drawObj->parent);
$levelObj = $self->drawParchment->ivShow('levelHash', $roomObj->zPosBlocks);
if ($self->quickDrawFlag) {
$newObj->raise();
} else {
$newObj->lower($levelObj->ivIndex('slaveCanvasObjList', 5));
}
# Set up the event handler for the canvas object
$self->setupCanvasObjEvent('exit', $newObj, $drawObj);
# Store the canvas object
$self->drawParchment->addDrawnOrnament($roomObj, $drawObj, [$newObj]);
return 1;
}
# Graphical operations - drawing canvas objects, support functions
sub prepareArrowHead {
# Called by $self->drawOneWayExit and $self->drawBentExit to prepare the position of an
# arrow-head on a one-way exit, on the line section nearest to the parent room
#
# Expected arguments
# $exitObj - The GA::Obj::Exit for which an arrowhead is being drawn
# $xPos, $yPos - The position of the parent room's gridblock on the map
# $posnListRef - Reference to a list of coordinates describing the start and end of
# the line section nearest to the parent room (only the first four
# items in the list are used)
#
# Return values
# 'undef' on improper arguments
# Otherwise returns the data string expected by GooCanvas2::CanvasRect
my ($self, $exitObj, $xPos, $yPos, $posnListRef, $check) = @_;
# Local variables
my ($arrowVectorRef, $points);
# Check for improper arguments
if (
! defined $exitObj || ! defined $xPos || ! defined $yPos || ! defined $posnListRef
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->prepareArrowHead', @_);
}
# Find the exit's arrow vector - a reference to a list, (x1, y1, x2, y2)
# (x1, y1) is a vector showing the direction of one half of the arrowhead, starting at
# the edge of the block. (x2, y2) is a vector showing the direction of travel of the
# other half
# (NB The calling function has already checked that $exitObj->mapDir is defined)
$arrowVectorRef = $self->ivShow('constArrowVectorHash', $exitObj->mapDir);
# Prepare the arrowhead, as a list of points
$points = ' M '
# Start
. (
$$posnListRef[2] + $xPos + (
$$arrowVectorRef[0] * int(
($self->drawRegionmap->blockWidthPixels
- $self->drawRegionmap->roomWidthPixels) / 3
)
)
)
. ' '
. (
$$posnListRef[3] + $yPos + (
$$arrowVectorRef[1] * int(
($self->drawRegionmap->blockHeightPixels
- $self->drawRegionmap->roomHeightPixels) / 3
)
)
)
# Centre (intersecting the exit line itself)
. ' L ' . ($$posnListRef[2] + $xPos) . ' ' . ($$posnListRef[3] + $yPos)
# End
. ' L '
. (
$$posnListRef[2] + $xPos + (
$$arrowVectorRef[2] * int(
($self->drawRegionmap->blockWidthPixels
- $self->drawRegionmap->roomWidthPixels) / 3
)
)
)
. ' '
. (
$$posnListRef[3] + $yPos + (
$$arrowVectorRef[3] * int(
($self->drawRegionmap->blockHeightPixels
- $self->drawRegionmap->roomHeightPixels) / 3
)
)
);
return $points;
}
sub reverseIntersectingLines {
# Called by $self->drawBentExit when drawing a 2-way bent exit with two roughly parellel
# lines
# This function detects whether those lines intersect each other, rather than run roughly
# parallel and, if so, corrrects the problem
#
# Expected arguments
# $listRef, $listRef2
# - Two list references, each of which contain a list of points which make up the
# beginning, end and middle bends of a single line
# - Each list is in the form
# (x, y, x, y, x, y, ...)
#
# Return values
# 'undef' on improper arguments
# Otherwise returns a list containing the modified $listRef and $listRef2
my ($self, $listRef, $listRef2, $check) = @_;
# Local variables
my $total;
# Check for improper arguments
if (! defined $listRef || ! defined $listRef2 || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->reverseIntersectingLines',
@_,
);
}
# Each pair of neighbouring points:
# x = $$listRef[n], y = $$listRef[n + 1]
# x = $$listRef2[n], y = $$listRef2[n + 1]
# ...may be the wrong way around, such that the two lines are not roughly parallel, but
# cross over each other somewhere between the two points
#
# For each neighbouring pairs of points, [n] and [n+1], work out whether the two lines
# between them lines intersect each other (rather than remaining roughly parallel) and, if
# so, reverse them to remove the intersection
# Get the number of points in the line (2 for each end of the line, plus the number of
# bends - if there are no bends, there are four points in the line)
$total = (scalar @$listRef / 2);
# Don't reverse points at the beginning of the lines (but we might have to reverse points
# at the end, as a knock-on effect of reversing points somewhere in the middle)
for (my $count = 1; $count < ($total - 1); $count++) {
my ($index, $dist1, $dist2, $dist3, $dist4, $spare);
$index = $count * 2;
# Work out the length of the two lines that should be parallel, as they are at the
# moment
$dist1 = sqrt(
(($$listRef[$index] - $$listRef[($index+ 2)]) ** 2)
+ (($$listRef[($index + 1)] - $$listRef[($index + 3)]) ** 2)
);
$dist2 = sqrt(
(($$listRef2[$index] - $$listRef2[($index + 2)]) ** 2)
+ (($$listRef2[($index + 1)] - $$listRef2[($index + 3)]) ** 2)
);
# Work out the length of the two lines that would be drawn, if the points at one end
# were reversed
$dist3 = sqrt(
(($$listRef[$index] - $$listRef2[($index + 2)]) ** 2)
+ (($$listRef[($index + 1)] - $$listRef2[($index + 3)]) ** 2)
);
$dist4 = sqrt(
(($$listRef2[$index] - $$listRef[($index + 2)]) ** 2)
+ (($$listRef2[($index + 1)] - $$listRef[($index + 3)]) ** 2)
);
# By adding the distances, we can work out if the second pair of points need to be
# reversed, in order to make the lines parallel
if (($dist1 + $dist2) > ($dist3 + $dist4)) {
$spare = $$listRef[($index + 2)];
$$listRef[($index + 2)] = $$listRef2[($index + 2)];
$$listRef2[($index + 2)] = $spare;
$spare = $$listRef[($index + 3)];
$$listRef[($index + 3)] = $$listRef2[($index + 3)];
$$listRef2[($index + 3)] = $spare;
}
}
return $listRef, $listRef2;
}
# Graphical lookup functions
sub getBlockCorner {
# Called by various functions
# Find the coordinates on the canvas of the pixel occupying the top-left corner of the
# specified gridblock
#
# Expected arguments
# $xPosBlocks, $yPosBlocks
# - Grid coordinates of a gridblock
#
# Optional arguments
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
# $flag - If set to TRUE, the gridblock coordinates are checked for validity. If set to
# FALSE (or 'undef'), we assume that they're valid
#
# Return values
# An empty list on improper arguments
# Otherwise, returns the pixel's coordinates as a list in the form (x, y)
my ($self, $xPosBlocks, $yPosBlocks, $regionmapObj, $flag, $check) = @_;
# Local variables
my @emptyList;
# Check for improper arguments
if (! defined $xPosBlocks || ! defined $yPosBlocks || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getBlockCorner', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Check the arguments, if necessary
if ($flag) {
if (
! $regionmapObj->checkGridBlock(
$xPosBlocks,
$yPosBlocks,
$regionmapObj->currentLevel,
)
) {
return @emptyList;
}
}
# Return the coordinates
return (
$xPosBlocks * $regionmapObj->blockWidthPixels,
$yPosBlocks * $regionmapObj->blockHeightPixels,
);
}
sub getBlockCentre {
# Called by various functions
# Find the coordinates on the canvas of the pixel occupying the centre of the specified
# gridblock (and of the room, if there is one)
#
# Expected arguments
# $xPosBlocks, $yPosBlocks
# - Grid coordinates of a gridblock
#
# Optional arguments
# $blockCornerXPosPixels, $blockCornerYPosPixels
# - The coordinates of the top-left pixel of the gridblock (the return values of
# $self->getBlockCorner). If not specified, $self->getBlockCorner is called to
# get them)
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
# $flag - If set to TRUE, the gridblock coordinates are checked for validity. If set to
# FALSE (or 'undef'), we assume that they're valid
#
# Return values
# An empty list on improper arguments
# Otherwise, the pixel's coordinates in a list in the form (x, y)
my (
$self, $xPosBlocks, $yPosBlocks, $blockCornerXPosPixels, $blockCornerYPosPixels,
$regionmapObj, $flag, $check,
) = @_;
# Local variables
my @emptyList;
# Check for improper arguments
if (! defined $xPosBlocks || ! defined $yPosBlocks || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getBlockCentre', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Check the arguments, if necessary
if ($flag) {
if (
! $regionmapObj->checkGridBlock(
$xPosBlocks,
$yPosBlocks,
$regionmapObj->currentLevel,
)
) {
return @emptyList;
}
}
# Get the coordinates of the block's top-left corner, if we don't have them
if (! defined $blockCornerXPosPixels) {
($blockCornerXPosPixels, $blockCornerYPosPixels)
= $self->getBlockCorner($xPosBlocks, $yPosBlocks, $regionmapObj);
}
# Return the coordinates
return (
$blockCornerXPosPixels + int($regionmapObj->blockWidthPixels / 2),
$blockCornerYPosPixels + int($regionmapObj->blockHeightPixels / 2),
);
}
sub getBorderCorner {
# Called by various functions
# Find the coordinates on the canvas of the pixel occupying the top-left corner of a room's
# border in the specified gridblock (if a room is drawn in this gridblock)
#
# Expected arguments
# $xPosBlocks, $yPosBlocks
# - Grid coordinates of a gridblock
#
# Optional arguments
# $blockCornerXPosPixels, $blockCornerYPosPixels
# - The coordinates of the top-left pixel of the gridblock (the return values of
# $self->getBlockCorner). If not specified, $self->getBlockCorner is called to
# get them)
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
# $flag - If set to TRUE, the gridblock coordinates are checked for validity. If set to
# FALSE (or 'undef'), we assume that they're valid
#
# Return values
# An empty list on improper arguments
# Otherwise, the pixel's coordinates in a list in the form (x, y)
my (
$self, $xPosBlocks, $yPosBlocks, $blockCornerXPosPixels, $blockCornerYPosPixels,
$regionmapObj, $flag, $check,
) = @_;
# Local variables
my @emptyList;
# Check for improper arguments
if (! defined $xPosBlocks || ! defined $yPosBlocks || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getBorderCorner', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Check the arguments, if necessary
if ($flag) {
if (
! $regionmapObj->checkGridBlock(
$xPosBlocks,
$yPosBlocks,
$regionmapObj->currentLevel,
)
) {
return @emptyList;
}
}
# Get the coordinates of the block's top-left corner, if we don't have them
if (! defined $blockCornerXPosPixels) {
($blockCornerXPosPixels, $blockCornerYPosPixels)
= $self->getBlockCorner($xPosBlocks, $yPosBlocks, $regionmapObj);
}
# Return the coordinates
return (
$blockCornerXPosPixels + int(
($regionmapObj->blockWidthPixels - $regionmapObj->roomWidthPixels) / 2
),
$blockCornerYPosPixels + int(
($regionmapObj->blockHeightPixels - $regionmapObj->roomHeightPixels) / 2
),
);
}
sub getBlockEdge {
# Called by various functions
# Find the coordinates on the canvas of the pixel at the edge of a gridblock which is
# intersected by a cardinal exit
#
# Expected arguments
# $xPosBlocks, $yPosBlocks
# - Grid coordinates of a gridblock
# $vectorRef
# - A value in the hash $self->constVectorHash, matching the direction of the
# exit's primary direction. The value is a reference to a list, e.g.
# northeast > [1, -1, 0]
#
# Optional arguments
# $blockCentreXPosPixels, $blockCentreYPosPixels
# - The coordinates of the pixel at the centre of the gridblock (and of the room,
# if one is drawn there)
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
# $flag - If set to TRUE, the gridblock coordinates are checked for validity. If set to
# FALSE (or 'undef'), we assume that they're valid
#
# Return values
# An empty list on improper arguments
# Otherwise, the pixel's coordinates in a list in the form (x, y)
my (
$self, $xPosBlocks, $yPosBlocks, $vectorRef, $blockCentreXPosPixels,
$blockCentreYPosPixels, $regionmapObj, $flag, $check,
) = @_;
# Local variables
my @emptyList;
# Check for improper arguments
if (
! defined $xPosBlocks || ! defined $yPosBlocks || ! defined $vectorRef || defined $check
) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getBlockEdge', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Check the arguments, if necessary
if ($flag) {
if (
! $regionmapObj->checkGridBlock(
$xPosBlocks,
$yPosBlocks,
$regionmapObj->currentLevel,
)
) {
return @emptyList;
}
}
# Get the coordinates of the block's centre, if we don't have them
if (! defined $blockCentreXPosPixels) {
($blockCentreXPosPixels, $blockCentreYPosPixels)
= $self->getBlockCentre($xPosBlocks, $yPosBlocks, undef, undef, $regionmapObj);
}
# Return the coordinates
return (
$blockCentreXPosPixels + (
$$vectorRef[0] * int($regionmapObj->blockWidthPixels / 2)
),
$blockCentreYPosPixels + (
$$vectorRef[1] * int($regionmapObj->blockHeightPixels / 2)
),
);
}
sub getNearBlockEdge {
# Called by various functions
# Find the coordinates on the canvas of the pixel near to the edge of a gridblock which is
# intersected by a cardinal exit (but not actually at the edge)
#
# Expected arguments
# $xPosBlocks, $yPosBlocks
# - Grid coordinates of a gridblock
# $vectorRef
# - A value in the hash $self->constVectorHash, matching the direction of the
# exit's primary direction. The value is a reference to a list, e.g.
# northeast > [1, -1, 0]
#
# Optional arguments
# $blockCentreXPosPixels, $blockCentreYPosPixels
# - The coordinates of the pixel at the centre of the gridblock (and of the room,
# if one is drawn there)
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
# $flag - If set to TRUE, the gridblock coordinates are checked for validity. If set to
# FALSE (or 'undef'), we assume that they're valid
#
# Return values
# An empty list on improper arguments
# Otherwise, the pixel's coordinates in a list in the form (x, y)
my (
$self, $xPosBlocks, $yPosBlocks, $vectorRef, $blockCentreXPosPixels,
$blockCentreYPosPixels, $regionmapObj, $flag, $check,
) = @_;
# Local variables
my @emptyList;
# Check for improper arguments
if (
! defined $xPosBlocks || ! defined $yPosBlocks || ! defined $vectorRef
|| defined $check
) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getNearBlockEdge', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Check the arguments, if necessary
if ($flag) {
if (
! $regionmapObj->checkGridBlock(
$xPosBlocks,
$yPosBlocks,
$regionmapObj->currentLevel,
)
) {
return @emptyList;
}
}
# Get the coordinates of the block's centre, if we don't have them
if (! defined $blockCentreXPosPixels) {
($blockCentreXPosPixels, $blockCentreYPosPixels)
= $self->getBlockCentre($xPosBlocks, $yPosBlocks, undef, undef, $regionmapObj);
}
# Return the coordinates
return (
$blockCentreXPosPixels + (
$$vectorRef[0] * (
int($regionmapObj->blockWidthPixels / 2) - int(
($regionmapObj->blockWidthPixels - $regionmapObj->roomWidthPixels) / 4
)
)
),
$blockCentreYPosPixels + (
$$vectorRef[1] * (
int($regionmapObj->blockHeightPixels / 2) - int(
($regionmapObj->blockHeightPixels - $regionmapObj->roomHeightPixels) / 4
)
)
),
);
}
sub getExitStart {
# Called by various functions
# Find the coordinates on the canvas of the pixel at the edge of the room (i.e. one pixel
# outside its border), from which a cardinal exit starts
#
# Expected arguments
# $xPosBlocks, $yPosBlocks
# - Grid coordinates of a gridblock
# $vectorRef
# - A value in the hash $self->constVectorHash, matching the direction of the
# exit's primary direction. The value is a reference to a list, e.g.
# northeast > [1, -1, 0]
#
# Optional arguments
# $blockCentreXPosPixels, $blockCentreYPosPixels
# - The coordinates of the pixel at the centre of the gridblock (and of the room,
# if one is drawn there)
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
# $flag - If set to TRUE, the gridblock coordinates are checked for validity. If set to
# FALSE (or 'undef'), we assume that they're valid
#
# Return values
# An empty list on improper arguments
# Otherwise, the pixel's coordinates in a list in the form (x, y)
my (
$self, $xPosBlocks, $yPosBlocks, $vectorRef, $blockCentreXPosPixels,
$blockCentreYPosPixels, $borderCornerXPosPixels, $borderCornerYPosPixels,
$regionmapObj, $flag, $check,
) = @_;
# Local variables
my (
$exitStartXPosPixels, $exitStartYPosPixels,
@emptyList,
);
# Check for improper arguments
if (
! defined $xPosBlocks || ! defined $yPosBlocks || ! defined $vectorRef || defined $check
) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getExitStart', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Check the arguments, if necessary
if ($flag) {
if (
! $regionmapObj->checkGridBlock(
$xPosBlocks,
$yPosBlocks,
$regionmapObj->currentLevel,
)
) {
return @emptyList;
}
}
# Get the coordinates of the room border's top-left corner and/or the block's centre if we
# don't have them
if (! defined $blockCentreXPosPixels) {
($blockCentreXPosPixels, $blockCentreYPosPixels)
= $self->getBlockCentre($xPosBlocks, $yPosBlocks, undef, undef, $regionmapObj);
}
if (! defined $borderCornerXPosPixels) {
($borderCornerXPosPixels, $borderCornerYPosPixels)
= $self->getBorderCorner($xPosBlocks, $yPosBlocks, undef, undef, $regionmapObj);
}
# Get the coordinates
$exitStartXPosPixels = $blockCentreXPosPixels + (
$$vectorRef[0] * (int($regionmapObj->roomWidthPixels / 2) + 1)
);
$exitStartYPosPixels = $blockCentreYPosPixels + (
$$vectorRef[1] * (int($regionmapObj->roomHeightPixels / 2) + 1)
);
# This algorithm can produce a pixel located on the border itself, not just outside it.
# Adjust the coordinates of the pixel as necessary
if ($exitStartXPosPixels == $borderCornerXPosPixels) {
$exitStartXPosPixels--;
} elsif (
$exitStartXPosPixels == ($borderCornerXPosPixels + $regionmapObj->roomWidthPixels - 1)
) {
$exitStartXPosPixels++;
}
if ($exitStartYPosPixels == $borderCornerYPosPixels) {
$exitStartYPosPixels--;
} elsif (
$exitStartYPosPixels == ($borderCornerYPosPixels + $regionmapObj->roomHeightPixels - 1)
) {
$exitStartYPosPixels++;
}
# Return the coordinates
return ($exitStartXPosPixels, $exitStartYPosPixels);
}
sub getBorderColour {
# Returns the colour in which a room's border should be drawn (which depends on several
# factors)
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room being drawn
#
# Return values
# On improper arguments, returns the list
# (default_border_colour, 'single')
# Otherwise, returns the list
# (border_colour, draw_room_mode)
# ...where 'draw_room_mode' is 'single', 'double' or 'interior' for the current/last
# known/ghost rooms, and 'single' for all other rooms
my ($self, $roomObj, $check) = @_;
# Check for improper arguments
if (! defined $roomObj || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getBorderColour', @_);
# Return the default colour
return ($self->worldModelObj->defaultBorderColour, 'single');
}
# Decide which colour to use
if ($self->pairedTwinRoom && $roomObj eq $self->pairedTwinRoom) {
if ($self->mapObj->currentRoom && $roomObj eq $self->mapObj->currentRoom) {
# Twin paired current room
return (
$self->drawScheme->selectExitTwinColour,
$self->worldModelObj->currentRoomMode,
);
} else {
# Twin paired (not current) room
return ($self->drawScheme->selectExitTwinColour, 'single');
}
} elsif (
! $self->mapObj->currentRoom
&& $self->mapObj->lastKnownRoom
&& $roomObj eq $self->mapObj->lastKnownRoom
) {
# Automapper is lost
if (
($self->selectedRoom && $roomObj eq $self->selectedRoom)
|| ($self->ivExists('selectedRoomHash', $roomObj->number))
) {
# Last known room is selected
return (
$self->drawScheme->lostSelectBorderColour,
$self->worldModelObj->currentRoomMode,
);
} else {
# Last known room is not selected
return (
$self->drawScheme->lostBorderColour,
$self->worldModelObj->currentRoomMode,
);
}
} elsif (
$self->mapObj->ghostRoom
&& $roomObj eq $self->mapObj->ghostRoom
&& (! $self->mapObj->currentRoom || $roomObj ne $self->mapObj->currentRoom)
) {
# Ghost room (presumed actual location of character right now)
if (
($self->selectedRoom && $roomObj eq $self->selectedRoom)
|| ($self->ivExists('selectedRoomHash', $roomObj->number))
) {
# Ghost room is selected
return (
$self->drawScheme->ghostSelectBorderColour,
$self->worldModelObj->currentRoomMode,
);
} else {
# Ghost room is not selected
return (
$self->drawScheme->ghostBorderColour,
$self->worldModelObj->currentRoomMode,
);
}
} elsif (
($self->selectedRoom && $roomObj eq $self->selectedRoom)
|| ($self->ivExists('selectedRoomHash', $roomObj->number))
) {
if ($self->mapObj->currentRoom && $roomObj eq $self->mapObj->currentRoom) {
# Current and selected room
return (
$self->drawScheme->currentSelectBorderColour,
$self->worldModelObj->currentRoomMode,
);
} else {
# Selected (but not current) room
return ($self->drawScheme->selectBorderColour, 'single');
}
} elsif ($self->mapObj->currentRoom && $roomObj eq $self->mapObj->currentRoom) {
if ($self->mode eq 'wait') {
# Current room in 'wait' mode
return (
$self->drawScheme->currentWaitBorderColour,
$self->worldModelObj->currentRoomMode,
);
} elsif ($self->mode eq 'follow') {
# Current room in 'follow' mode
return (
$self->drawScheme->currentFollowBorderColour,
$self->worldModelObj->currentRoomMode,
);
} else {
# Current room in 'update' mode
return (
$self->drawScheme->currentBorderColour,
$self->worldModelObj->currentRoomMode,
);
}
} else {
# Default border colour
return ($self->drawScheme->borderColour, 'single');
}
}
sub getRoomColour {
# Returns the colour in which a room's interior should be drawn (which depends on several
# factors)
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room being drawn
#
# Return values
# The default interior colour on improper arguments
# Otherwise, returns the colour with which to draw the room interior
my ($self, $roomObj, $check) = @_;
# Local variables
my (
$highestFlagObj, $highestScore,
@flagList,
);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getRoomColour', @_);
# Return the default colour
return $self->worldModelObj->defaultRoomColour;
}
# Sort the room's room flags by priority
# Work out which flag has the highest priority, while still being available through the
# filters specified in GA::Obj::WorldModel->roomFilterApplyHash
$highestScore = 0;
foreach my $roomFlag ($roomObj->ivKeys('roomFlagHash')) {
my $roomFlagObj = $self->worldModelObj->ivShow('roomFlagHash', $roomFlag);
if (
$roomFlagObj
&& (
$self->worldModelObj->allRoomFiltersFlag
|| $self->worldModelObj->ivShow('roomFilterApplyHash', $roomFlagObj->filter)
)
) {
# This room flag can be drawn, if it's the highest-priority one
if ($highestScore == 0 || $roomFlagObj->priority < $highestScore) {
# $flag's colour takes priority
$highestFlagObj = $roomFlagObj;
$highestScore = $roomFlagObj->priority;
}
}
}
if ($highestFlagObj) {
# This flag's colour has the highest priority, so it's the one we draw
$roomObj->ivPoke('lastRoomFlag', $highestFlagObj->name);
return $highestFlagObj->colour;
} else {
# Room has no flags set - use the default colour
return $self->drawScheme->roomColour;
}
}
sub getRoomTagColour {
# Returns the colour in which a room tag should be drawn (which depends on several factors)
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room whose room tag is being drawn
#
# Return values
# The default room tag colour on improper arguments
# Otherwise, returns the colour with which to draw the room tag
my ($self, $roomObj, $check) = @_;
# Check for improper arguments
if (! defined $roomObj || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getRoomTagColour', @_);
# Return the default colour
return $self->worldModelObj->defaultRoomTagColour;
}
# Decide which colour to use
if (
($self->selectedRoomTag && $self->selectedRoomTag eq $roomObj)
|| $self->ivExists('selectedRoomTagHash', $roomObj->number)
) {
# Selected room tag
return $self->drawScheme->selectRoomTagColour;
} else {
# Default room tag colour
return $self->drawScheme->roomTagColour;
}
}
sub getRoomGuildColour {
# Returns the colour in which a room guild should be drawn (which depends on several
# factors)
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room whose room guild is being drawn
#
# Return values
# The default room guild colour on improper arguments
# Otherwise, returns the colour with which to draw the room guild
my ($self, $roomObj, $check) = @_;
# Check for improper arguments
if (! defined $roomObj || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getRoomGuildColour', @_);
# Return the default colour
return $self->worldModelObj->defaultRoomGuildColour;
}
# Decide which colour to use
if (
($self->selectedRoomGuild && $self->selectedRoomGuild eq $roomObj)
|| $self->ivExists('selectedRoomGuildHash', $roomObj->number)
) {
# Selected room guild
return $self->drawScheme->selectRoomGuildColour;
} else {
# Default room guild colour
return $self->drawScheme->roomGuildColour;
}
}
sub getExitColour {
# Returns the colour in which an exit should be drawn (which depends on several factors)
#
# Expected arguments
# $exitObj - The GA::Obj::Exit being drawn
#
# Return values
# The default exit colour on improper arguments
# Otherwise, returns the colour with which to draw the exit
my ($self, $exitObj, $check) = @_;
# Local variables
my $twinExitObj;
# Check for improper arguments
if (! defined $exitObj || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getExitColour', @_);
# Return the default colour
return $self->worldModelObj->defaultExitColour;
}
# Get the exit's twin, if there is one
if ($exitObj->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow('exitModelHash', $exitObj->twinExit);
}
# Decide which colour to use
if ($self->pairedTwinExit && $exitObj eq $self->pairedTwinExit) {
# Twin paired room
return $self->drawScheme->selectExitTwinColour;
} elsif (
(
$self->selectedExit
&& (
$exitObj eq $self->selectedExit
|| (
$twinExitObj
&& $twinExitObj eq $self->selectedExit
# (Bent exits have their ->brokenFlag set to TRUE - we only care about
# non-bent broken exits here)
&& ((! $twinExitObj->brokenFlag) || $twinExitObj->bentFlag)
&& ! $twinExitObj->regionFlag
)
)
) || (
$self->ivExists('selectedExitHash', $exitObj->number)
) || (
$twinExitObj && $self->ivExists(
'selectedExitHash',
$twinExitObj->number,
)
)
) {
# Selected exit (or the exit's twin is selected, so draw it as if it were selected too)
return $self->drawScheme->selectExitColour;
} elsif (
$self->selectedExit && $exitObj ne $self->selectedExit
&& $self->selectedExit->shadowExit
&& $self->selectedExit->shadowExit == $exitObj->number
) {
# $exitObj is a shadow exit of the selected exit. Draw it in a slightly different colour
# to a selected exit (default is orange)
return $self->drawScheme->selectExitShadowColour;
} elsif ($exitObj->exitOrnament eq 'impass') {
return $self->drawScheme->impassableExitColour;
} elsif ($exitObj->exitOrnament eq 'mystery') {
return $self->drawScheme->mysteryExitColour;
} else {
# Default exit colour
return $self->drawScheme->exitColour;
}
}
sub getExitTagColour {
# Returns the colour in which an exit tag should be drawn (which depends on several factors)
#
# Expected arguments
# $exitObj - The GA::Obj::Exit whose exit tag is being drawn
#
# Return values
# The default exit tag colour on improper arguments
# Otherwise, returns the colour with which to draw the exit tag
my ($self, $exitObj, $check) = @_;
# Local variables
my $twinExitObj;
# Check for improper arguments
if (! defined $exitObj || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getExitTagColour', @_);
# Return the default colour
return $self->worldModelObj->defaultExitTagColour;
}
# Get the exit's twin, if there is one
if ($exitObj->twinExit) {
$twinExitObj = $self->worldModelObj->ivShow('exitModelHash', $exitObj->twinExit);
}
# Decide which colour to use
if (
($self->selectedExitTag && $self->selectedExitTag eq $exitObj)
|| $self->ivExists('selectedExitTagHash', $exitObj->number)
) {
# Selected exit tag
return $self->drawScheme->selectExitTagColour;
} else {
# Default exit tag colour
return $self->drawScheme->exitTagColour;
}
}
# Other lookup functions
sub findRegionNum {
# Can be called by anything
# Given a region's name, looks up its world model number
#
# Expected arguments
# $name - The region's name (matches GA::ModelObj::Region->name)
#
# Return values
# 'undef' on improper arguments or if no matching region is found
# Otherwise returns the model number (matches GA::ModelObj::Region->number) of the
# matching region
my ($self, $name, $check) = @_;
# Local variables
my $regionmapObj;
# Check for improper arguments
if (! defined $name || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findRegionNum', @_);
}
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $name);
if (! $regionmapObj) {
return undef;
} else {
return $regionmapObj->number;
}
}
sub findRegionObj {
# Can be called by anything
# Given a region's name, returns the region model object (GA::ModelObj::Region)
#
# Expected arguments
# $name - The region's name (matches GA::ModelObj::Region->name)
#
# Return values
# 'undef' on improper arguments or if no matching region is found
# Otherwise returns the matching region object
my ($self, $name, $check) = @_;
# Local variables
my $regionmapObj;
# Check for improper arguments
if (! defined $name || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findRegionNum', @_);
}
$regionmapObj = $self->worldModelObj->ivShow('regionmapHash', $name);
if (! $regionmapObj) {
return undef;
} else {
return $self->worldModelObj->ivShow('modelHash', $regionmapObj->number);
}
}
sub findRegionmap {
# Can be called by anything
# Given the ->number of a region model object (GA::ModelObj::Region), returns the equivalent
# regionmap object (GA::Obj::Regionmap)
#
# Expected arguments
# $number - The number of a region model object
#
# Return values
# 'undef' on improper arguments or if no matching regionmap is found
# Otherwise returns the matching GA::Obj::Regionmap
my ($self, $number, $check) = @_;
# Local variables
my $regionObj;
# Check for improper arguments
if (! defined $number || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findRegionmap', @_);
}
$regionObj = $self->worldModelObj->ivShow('regionModelHash', $number);
if (! $regionObj) {
return undef;
} else {
return $self->worldModelObj->ivShow('regionmapHash', $regionObj->name);
}
}
sub findGridBlock {
# Called by $self->mouseClickEvent or any other function
# Given (x, y) coordinates on the map (in pixels), finds the (x, y) coordinates of the
# corresponding gridblock (in blocks)
#
# Expected arguments
# $xPosPixels, $yPosPixels - The coordinates of a pixel
#
# Optional arguments
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
#
# Return values
# An empty list on improper argument or if no corresponding block exists (because the
# pixel coordinates are invalid)
# Otherwise, a list containing coordinates of the gridblock, in the form (x, y)
my ($self, $xPosPixels, $yPosPixels, $regionmapObj, $check) = @_;
# Local variables
my (
$xPosBlocks, $yPosBlocks,
@emptyList,
);
# Check for improper arguments
if (! defined $xPosPixels || ! defined $yPosPixels || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findGridBlock', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Check that ($xPosPixels, $yPosPixels) is a set of coordinates that's actually on the
# canvas
if (
$xPosPixels < 0
|| $yPosPixels < 0
|| $xPosPixels >= ($regionmapObj->gridWidthBlocks * $regionmapObj->blockWidthPixels)
|| $yPosPixels >= ($regionmapObj->gridHeightBlocks * $regionmapObj->blockHeightPixels)
) {
# Mouse click didn't occur in a gridblock
return @emptyList;
}
# Find the block
$xPosBlocks = int ($xPosPixels / $regionmapObj->blockWidthPixels);
$yPosBlocks = int ($yPosPixels / $regionmapObj->blockHeightPixels);
return ($xPosBlocks, $yPosBlocks);
}
sub findClickedExit {
# Called by $self->mouseClickEvent or any other function
# Given a block in the grid (which contains a GA::ModelObj::Room) and the coordinates of a
# pixel somewhere in the same block, see if any of the exits were drawn underneath (or
# almost underneath) the clicked pixel
# $self->exitSensitivity sets a minimum standard for how close the mouse click must be to
# the drawn exit. Of all the exits that meet this minimum standard, we return the
# best-fitting one
#
# Expected arguments
# $clickXPosPixels, $clickYPosPixels
# - The coordinates of the clicked pixel
# $roomObj - The GA::ModelObj::Room in this gridblock
#
# Optional arguments
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
#
# Return values
# 'undef' on improper arguments, or if the click isn't on (or very near) an exit
# Otherwise, returns the blessed reference of the closest GA::Obj::Exit
my ($self, $clickXPosPixels, $clickYPosPixels, $roomObj, $regionmapObj, $check) = @_;
# Local variables
my (
$blockCornerXPosPixels, $blockCornerYPosPixels, $blockCentreXPosPixels,
$blockCentreYPosPixels, $borderCornerXPosPixels, $borderCornerYPosPixels,
$startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels, $angleBAC,
$anglePAD, $gapAngle, $bestExitObj, $bestExitGapAngle,
);
# Check for improper arguments
if (
! defined $clickXPosPixels || ! defined $clickYPosPixels || ! defined $roomObj
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findClickedExit', @_);
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Get some coordinates that we'll need to pass to the functions that tell us where the exits
# are drawn
# Find the coordinates on the canvas of the pixel occupying the top-left corner of the
# gridblock specified by $roomObj
($blockCornerXPosPixels, $blockCornerYPosPixels) = $self->getBlockCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$regionmapObj,
);
# Find the coordinates of the pixel occupying the centre of the block (and of the room)
($blockCentreXPosPixels, $blockCentreYPosPixels) = $self->getBlockCentre(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$blockCornerXPosPixels,
$blockCornerYPosPixels,
$regionmapObj,
);
# Find the coordinates of the pixel at the top-left corner of the room's border
($borderCornerXPosPixels, $borderCornerYPosPixels) = $self->getBorderCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$blockCornerXPosPixels,
$blockCornerYPosPixels,
$regionmapObj,
);
# Now, for each exit in this room...
OUTER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my ($exitObj, $mapDir);
$exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if (! $exitObj) {
next OUTER;
}
# Get the direction in which the exit is drawn. If not set, move on to the next exit
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
next OUTER;
}
# We can't click 'up' and 'down', just the sixteen cardinal directions
if ($mapDir eq 'up' || $mapDir eq 'down') {
next OUTER;
}
# For unallocated exits allocated a temporary primary direction, for broken/region exits
# and for exits with the impassable ornament, we have a very definite square within
# which the user has to click - no need for any trigonometry
if (
$exitObj->drawMode eq 'temp_alloc'
|| $exitObj->brokenFlag
|| $exitObj->regionFlag
|| $exitObj->exitOrnament eq 'impass'
|| $exitObj->exitOrnament eq 'mystery'
) {
# Get the coordinates of two corners of the square occupied by the exit
# NB ($startXPosPixels, $startYPosPixels) is lower and further to the left than
# ($stopXPosPixels, $stopYPosPixels)
($startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels)
= $self->findSquareExit(
$roomObj,
$exitObj,
$mapDir,
$blockCentreXPosPixels,
$blockCentreYPosPixels,
$regionmapObj,
);
if (
$clickXPosPixels >= $startXPosPixels
&& $clickXPosPixels <= $stopXPosPixels
&& $clickYPosPixels <= $startYPosPixels
&& $clickYPosPixels >= $stopYPosPixels
) {
# This is the selected exit
return $exitObj;
} else {
next OUTER;
}
}
# Get the coordinates of the pixel at each end of the line that forms the drawn exit
# NB This line repeats below. Change one, change both!
if (
$exitObj->destRoom
&& ($exitObj->twinExit || $exitObj->oneWayFlag)
) {
# It's a two-way exit or one-way exit (more than one gridblock)
($startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels)
= $self->findLongExit(
$roomObj,
$exitObj,
$mapDir,
$blockCentreXPosPixels,
$blockCentreYPosPixels,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$regionmapObj,
);
} else {
# It's an incomplete or uncertain exit (confined to the same gridblock as its room)
# It's a two-way exit or one-way exit (more than one gridblock)
($startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels)
= $self->findShortExit(
$roomObj,
$exitObj,
$mapDir,
$blockCentreXPosPixels,
$blockCentreYPosPixels,
$regionmapObj,
);
}
# The mouse click must be vaguely near the exit, to count...
if (
! $self->checkCredibleExit(
$clickXPosPixels, $clickYPosPixels,
$startXPosPixels, $startYPosPixels,
$stopXPosPixels, $stopYPosPixels,
)
) {
# Mouse click is too far away
next OUTER;
}
# x B x P
# xx xx
# x x x x
# P x x x
# x x x x
# x @ x x N x
# A xxxxDxx C A xxxxxxx D
#
# ABC is a right-angled triangle.
# A is the start of the exit (coordinates $startXPosPixels, $startYPosPixels), B is the
# end of the exit (coordinates $stopXPosPixels, $stopYPosPixels).
# The clicked pixel P (coordinates $clickXPosPixels, $clickYPosPixels) is somewhere
# along the line AB - or close to it. It is nearer to A than it is to B
#
# Now check the gradient of the line AP. If it is close enough to the gradient of AB, we
# can consider that this exit was the one that was clicked
# (Actually, we check the angle @ in the triangle ABC, and the angle N in the triangle
# APD. The two triangles are not drawn to scale. If the angles are close enough - that
# is to say, within $self->exitSensitivity radians of each other, it's the right exit
$angleBAC = abs(
$self->findExitAngles(
$startXPosPixels,
$startYPosPixels,
$stopXPosPixels,
$stopYPosPixels,
)
);
$anglePAD = abs(
$self->findExitAngles(
$startXPosPixels,
$startYPosPixels,
$clickXPosPixels,
$clickYPosPixels,
)
);
# Find the difference between the two angles
$gapAngle = abs($anglePAD - $angleBAC);
if ($gapAngle < $self->exitSensitivity) {
# The exit is acceptably close to the mouse click. If it is closer than any
# previously found acceptable exit, use it
if (! defined $bestExitObj || $bestExitGapAngle > $gapAngle) {
$bestExitObj = $exitObj;
$bestExitGapAngle = $gapAngle;
}
}
}
# Return the best-fitting exit we found (if none were found acceptably close to the exit,
# return 'undef')
return $bestExitObj;
}
sub findClosestPoint {
# Called by $self->findClickedExit
# Given the coordinates of two pixels on the map, work out which one of them is closer to
# the point of a mouse click, and return the coordinates of the closer point
#
# Expected arguments
# $clickXPosPixels, $clickYPosPixels
# - The coordinates of the clicked pixel
# $startXPosPixels, $startYPosPixels
# - The coordinates of the first point
# $stopXPosPixels, $stopYPosPixels
# - The coordinates of the second point
#
# Return values
# On improper arguments, returns the list ($startXPosPixels, $startYPosPixels)
# Otherwise, returns the coordinates of the closer pixel as a list in the form (x, y)
my (
$self, $clickXPosPixels, $clickYPosPixels, $startXPosPixels, $startYPosPixels,
$stopXPosPixels, $stopYPosPixels, $check
) = @_;
# Local variables
my ($lengthAD, $lengthCD, $lengthAC, $lengthBD, $lengthBC);
# Check for improper arguments
if (
! defined $clickXPosPixels || ! defined $clickYPosPixels || ! defined $startXPosPixels
|| ! defined $startYPosPixels || ! defined $stopXPosPixels || ! defined $stopYPosPixels
|| defined $check
) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findClosestPoint', @_);
return ($startXPosPixels, $startYPosPixels);
}
# x C
# xx
# x x
# x x
# A xxxxx D
#
# A is ($startXPosPixels, $startYPosPixels), C is the position of the mouse click
# Get the length of AC
$lengthAD = abs($clickXPosPixels - $startXPosPixels);
$lengthCD = abs($clickYPosPixels - $startYPosPixels);
$lengthAC = sqrt (($lengthAD ** 2) + ($lengthCD ** 2));
# x C
# xx
# x x
# x x
# B xxxxx D
#
# B is ($stopXPosPixels, $stopYPosPixels), C is the position of the mouse click
# Get the length of BC
$lengthBD = abs($clickXPosPixels - $stopXPosPixels);
$lengthCD = abs($clickYPosPixels - $stopYPosPixels);
$lengthBC = sqrt (($lengthBD ** 2) + ($lengthCD ** 2));
if ($lengthAC <= $lengthBC) {
# Pixel A is closer (or both pixels are equidistant)
return ($startXPosPixels, $startYPosPixels);
} else {
# Pixel B is closer
return ($stopXPosPixels, $stopYPosPixels);
}
}
sub findExitAngles {
# Called by $self->findClickedExit to find the gradients of a line (as described in the
# comments for that function)
# Actually, we take the line as the hypotenuse of a right-angled triangle, and return the
# angle (in degrees) between the hypotenuse and the adjacent
#
# Expected arguments
# $startXPosPixels, $startYPosPixels
# - Coordinates of the pixel at one end of the line
# $stopXPosPixels, $stopYPosPixels
# - Coordinates of the pixel at the other end of the line
#
# Return values
# 'undef' on improper arguments
# Otherwise, the angle described above (in the range 0-90)
my (
$self, $startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels, $check
) = @_;
# Local variables
my ($lengthAC, $lengthBC, $angleBAC);
# Check for improper arguments
if (
! defined $startXPosPixels || ! defined $startYPosPixels || ! defined $stopXPosPixels
|| ! defined $stopYPosPixels || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findExitAngles', @_);
}
# Get the length of the adjacent
$lengthAC = abs($stopXPosPixels - $startXPosPixels);
# Get the length of the opposite
$lengthBC = abs($stopYPosPixels - $startYPosPixels);
# Get the angle between the hypotenuse and the adjacent, in degrees
if (! $lengthBC) {
$angleBAC = 0;
} elsif (! $lengthAC) {
$angleBAC = 90;
} else {
$angleBAC = Math::Trig::rad2deg(Math::Trig::atan($lengthBC / $lengthAC));
}
return $angleBAC;
}
sub findLongExit {
# Called by $self->drawOneWayExit, ->drawTwoWayExit and ->findClickedExit
# Returns the coordinates of the pixels at each end of a straight line between the points at
# which an exit meets a room (on a pixel occupied by the exit, not by the room's border)
# This gives us the position of a one-way or two-way exit
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room from which the exit
# starts
# $exitObj - Blessed reference of the GA::Obj::Exit
# $cardinalDir - One of the sixteen cardinal directions (e.g. 'north') in which the
# exit is drawn
#
# Optional arguments
# $blockCentreXPosPixels, $blockCentreYPosPixels
# - Coordinates of the pixel occupying the centre of the block (and of the
# room) (if 'undef', calculated by this function)
# $borderCornerXPosPixels, $borderCornerYPosPixels
# - Coordinates of the pixel at the top-left corner of the room's border (if
# 'undef', calculated by this function)
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
#
# Return values
# An empty list on improper arguments
# Otherwise, returns the coordinates of the two pixels as a list in the form
# (startX, startY, stopX, stopY)
my (
$self, $roomObj, $exitObj, $cardinalDir, $blockCentreXPosPixels,
$blockCentreYPosPixels, $borderCornerXPosPixels, $borderCornerYPosPixels,
$regionmapObj, $check,
) = @_;
# Local variables
my (
$blockCornerXPosPixels, $blockCornerYPosPixels, $destRoomObj, $vectorRef,
$oppCardinalDir, $oppVectorRef, $exitStartXPosPixels, $exitStartYPosPixels,
$newBlockCornerXPosPixels, $newBlockCornerYPosPixels, $newBlockCentreXPosPixels,
$newBlockCentreYPosPixels, $newBorderCornerXPosPixels, $newBorderCornerYPosPixels,
$exitStopXPosPixels, $exitStopYPosPixels,
@emptyList,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $cardinalDir || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findLongExit', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# If the four optional arguments weren't supplied, get them now
if (! defined $borderCornerXPosPixels || ! defined $blockCentreXPosPixels) {
# Find the coordinates on the canvas of the pixel occupying the top-left corner of the
# gridblock specified by $roomObj
($blockCornerXPosPixels, $blockCornerYPosPixels) = $self->getBlockCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$regionmapObj,
);
# Find the coordinates of the pixel occupying the centre of the block (and of the room)
($blockCentreXPosPixels, $blockCentreYPosPixels) = $self->getBlockCentre(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$blockCornerXPosPixels,
$blockCornerYPosPixels,
$regionmapObj,
);
# Find the coordinates of the pixel at the top-left corner of the room's border
($borderCornerXPosPixels, $borderCornerYPosPixels) = $self->getBorderCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$blockCornerXPosPixels,
$blockCornerYPosPixels,
$regionmapObj,
);
}
# Find the exit's destination room
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->destRoom);
# Find the exit's vector - a reference to a list of 3d coordinates, (x, y, z)
# e.g. northeast > (1, 1, 0)
$vectorRef = $self->ivShow('constVectorHash', $cardinalDir);
# Get the opposite direction of $cardinalDir (e.g. 'north' > 'south')
$oppCardinalDir = $axmud::CLIENT->ivShow('constOppDirHash', $cardinalDir);
# Get the exit's vector from the centre of the arrival room (should be equal and opposite to
# $vectorRef)
$oppVectorRef = $self->ivShow('constVectorHash', $oppCardinalDir);
# Find the coordinates of the pixel at the edge of the room, just outside the border, from
# which a cardinal exit starts
($exitStartXPosPixels, $exitStartYPosPixels) = $self->getExitStart(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$vectorRef,
$blockCentreXPosPixels,
$blockCentreYPosPixels,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$regionmapObj,
);
# Find the coordinates on the canvas of the pixel occupying the top-left corner of the
# gridblock occupied by the arrival room
($newBlockCornerXPosPixels, $newBlockCornerYPosPixels) = $self->getBlockCorner(
$destRoomObj->xPosBlocks,
$destRoomObj->yPosBlocks,
$regionmapObj,
);
# Find the coordinates of the pixel occupying the centre of this block (and of its room)
($newBlockCentreXPosPixels, $newBlockCentreYPosPixels) = $self->getBlockCentre(
$destRoomObj->xPosBlocks,
$destRoomObj->yPosBlocks,
$newBlockCornerXPosPixels,
$newBlockCornerYPosPixels,
$regionmapObj,
);
# Find the coordinates of the pixel occupying the top-left corner of the room's border
($newBorderCornerXPosPixels, $newBorderCornerYPosPixels) = $self->getBorderCorner(
$destRoomObj->xPosBlocks,
$destRoomObj->yPosBlocks,
undef,
undef,
$regionmapObj,
);
# Find the coordinates of the pixel at the edge of the arrival room, just outside the
# border, at which the cardinal exit stops
($exitStopXPosPixels, $exitStopYPosPixels) = $self->getExitStart(
$destRoomObj->xPosBlocks,
$destRoomObj->yPosBlocks,
$oppVectorRef,
$newBlockCentreXPosPixels,
$newBlockCentreYPosPixels,
$newBorderCornerXPosPixels,
$newBorderCornerYPosPixels,
$regionmapObj,
);
# Return the coordinates of each end of the exit
return (
$exitStartXPosPixels,
$exitStartYPosPixels,
$exitStopXPosPixels,
$exitStopYPosPixels,
);
}
sub findShortExit {
# Called by $self->findClickedExit (only)
# Returns the coordinates of the pixels at each end of a straight line between the start of
# an exit, and the edge of a gridblock where it intersects
# This gives us the (approximate) position of an incomplete or uncertain exit
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room from which the exit
# starts
# $exitObj - Blessed reference of the GA::Obj::Exit
# $cardinalDir - One of the sixteen cardinal directions (e.g. 'north') in which the
# exit is drawn
#
# Optional arguments
# $blockCentreXPosPixels, $blockCentreYPosPixels
# - Coordinates of the pixel occupying the centre of the block (and of the room) (if
# 'undef', calculated by this function)
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
#
# Return values
# An empty list on improper arguments
# Otherwise, returns the coordinates of the two pixels as a list in the form
# (startX, startY, stopX, stopY)
my (
$self, $roomObj, $exitObj, $cardinalDir, $blockCentreXPosPixels, $blockCentreYPosPixels,
$regionmapObj, $check,
) = @_;
# Local variables
my (
$blockCornerXPosPixels, $blockCornerYPosPixels, $exitStartXPosPixels,
$exitStartYPosPixels, $blockEdgeXPosPixels, $blockEdgeYPosPixels, $vectorRef,
$borderCornerXPosPixels, $borderCornerYPosPixels,
@emptyList,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $cardinalDir || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findShortExit', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# If the two optional arguments weren't supplied, get them now
if (! defined $blockCentreXPosPixels) {
# Find the coordinates on the canvas of the pixel occupying the top-left corner of the
# gridblock specified by $roomObj
($blockCornerXPosPixels, $blockCornerYPosPixels) = $self->getBlockCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$regionmapObj,
);
# Find the coordinates of the pixel occupying the centre of the block (and of the room)
($blockCentreXPosPixels, $blockCentreYPosPixels) = $self->getBlockCentre(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$blockCornerXPosPixels,
$blockCornerYPosPixels,
$regionmapObj,
);
}
# Find the exit's vector - a reference to a list of 3d coordinates, (x, y, z)
# e.g. northeast > (1, 1, 0)
$vectorRef = $self->ivShow('constVectorHash', $cardinalDir);
# Find the coordinates of the pixel occupying the top-left corner of the room's border
($borderCornerXPosPixels, $borderCornerYPosPixels) = $self->getBorderCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
undef,
undef,
$regionmapObj,
);
# Find the coordinates of the pixel at the edge of the room, just outside the border, from
# which a cardinal exit starts
($exitStartXPosPixels, $exitStartYPosPixels) = $self->getExitStart(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$vectorRef,
$blockCentreXPosPixels,
$blockCentreYPosPixels,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$regionmapObj,
);
# Find the coordinates of the pixel at the edge of the gridblock, which is intersected by a
# cardinal exit
($blockEdgeXPosPixels, $blockEdgeYPosPixels) = $self->getBlockEdge(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$vectorRef,
$blockCentreXPosPixels,
$blockCentreYPosPixels,
$regionmapObj,
);
# Return the coordinates of each end of the exit
return (
$exitStartXPosPixels,
$exitStartYPosPixels,
$blockEdgeXPosPixels,
$blockEdgeYPosPixels,
);
}
sub findSquareExit {
# Called by $self->drawUnallocatedExit (etc) and $self->findClickedExit
# Returns the coordinates of the pixels at opposite corners of a square in which an
# unallocated (or similar) exit is drawn
#
# Expected arguments
# $roomObj - Blessed reference of the GA::ModelObj::Room from which the exit
# starts
# $exitObj - Blessed reference of the GA::Obj::Exit
# $cardinalDir - One of the sixteen cardinal directions (e.g. 'north') in which the
# exit is drawn
#
# Optional arguments
# $blockCentreXPosPixels, $blockCentreYPosPixels
# - Coordinates of the pixel occupying the centre of the block (and of the
# room) (if 'undef', calculated by this function)
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is used
#
# Return values
# An empty list on improper arguments
# Otherwise, returns the coordinates of the two pixels at opposite corners as a list in
# the form (startX, startY, stopX, stopY).
# NB (startX, startY) always tends to be lower and further to the left on the map than
# (stopX, stopY)
my (
$self, $roomObj, $exitObj, $cardinalDir, $blockCentreXPosPixels, $blockCentreYPosPixels,
$regionmapObj, $check
) = @_;
# Local variables
my (
$vectorRef, $exitStartXPosPixels, $exitStartYPosPixels, $blockEdgeXPosPixels,
$blockEdgeYPosPixels, $halfHorizontalLength, $halfVerticalLength,
$squareStartXPosPixels, $squareStartYPosPixels, $squareStopXPosPixels,
$squareStopYPosPixels, $borderCornerXPosPixels, $borderCornerYPosPixels,
@emptyList,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || ! defined $cardinalDir || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findSquareExit', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Find the exit's vector - a reference to a list of 3d coordinates, (x, y, z)
# e.g. northeast > (1, 1, 0)
$vectorRef = $self->ivShow('constVectorHash', $cardinalDir);
# Find the coordinates of the pixel occupying the top-left corner of the room's border
($borderCornerXPosPixels, $borderCornerYPosPixels) = $self->getBorderCorner(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
undef,
undef,
$regionmapObj,
);
# Find the coordinates of the pixel at the edge of the room, just outside the border, from
# which a cardinal exit starts
($exitStartXPosPixels, $exitStartYPosPixels) = $self->getExitStart(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$vectorRef,
$blockCentreXPosPixels,
$blockCentreYPosPixels,
$borderCornerXPosPixels,
$borderCornerYPosPixels,
$regionmapObj,
);
# Find the coordinates of the pixel near (but not at) the edge of the gridblock, which is
# intersected by a cardinal exit
($blockEdgeXPosPixels, $blockEdgeYPosPixels) = $self->getNearBlockEdge(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$vectorRef,
$blockCentreXPosPixels,
$blockCentreYPosPixels,
$regionmapObj,
);
# Adjust the coordinates of the two pixels at either end of the exit, so that it's easier to
# draw '+' exits (and so that '+' are the same size as 'x')
# The line (or the square for which the ends of the line are in opposite corners) must have
# an odd-numbered length, so that the '+' and 'x' are symmetrical
if (
$exitStartXPosPixels != $blockEdgeXPosPixels
&& int(($blockEdgeXPosPixels - $exitStartXPosPixels) / 2)
!= (($blockEdgeXPosPixels - $exitStartXPosPixels) / 2)
) {
# Adjust the end of the line, to make it slightly bigger
$blockEdgeXPosPixels += $$vectorRef[0];
}
if (
$exitStartYPosPixels != $blockEdgeYPosPixels
&& int(($blockEdgeYPosPixels - $exitStartYPosPixels) / 2)
!= (($blockEdgeYPosPixels - $exitStartYPosPixels) / 2)
) {
# Adjust the end of the line, to make it slightly bigger
$blockEdgeYPosPixels += $$vectorRef[1];
}
# Adjust the coordinates so that the exit's start is below and to the left of the block's
# edge, by reversing coordinates where necessary
if ($exitStartXPosPixels > $blockEdgeXPosPixels) {
($exitStartXPosPixels, $blockEdgeXPosPixels)
= ($blockEdgeXPosPixels, $exitStartXPosPixels);
}
if ($exitStartYPosPixels < $blockEdgeYPosPixels) {
($exitStartYPosPixels, $blockEdgeYPosPixels)
= ($blockEdgeYPosPixels, $exitStartYPosPixels);
}
# North/east/south/west
if (
$exitStartXPosPixels eq $blockEdgeXPosPixels
|| $exitStartYPosPixels eq $blockEdgeYPosPixels
) {
# North/south
if ($exitStartXPosPixels eq $blockEdgeXPosPixels) {
# Get half the length of the exit
$halfHorizontalLength = abs(int(($blockEdgeYPosPixels - $exitStartYPosPixels) / 2));
# Find the coordinates of the one corner of the square occupied by the 'x'
$squareStartXPosPixels = $exitStartXPosPixels - $halfHorizontalLength;
$squareStartYPosPixels = $exitStartYPosPixels;
# Find the coordinates of the opposite corner of the square
$squareStopXPosPixels = $blockEdgeXPosPixels + $halfHorizontalLength;
$squareStopYPosPixels = $blockEdgeYPosPixels;
# East/west
} else {
# Get half the length of the exit
$halfVerticalLength = abs(int(($blockEdgeXPosPixels - $exitStartXPosPixels) / 2));
# Find the coordinates of the one corner of the square occupied by the 'x'
$squareStartXPosPixels = $exitStartXPosPixels;
$squareStartYPosPixels = $exitStartYPosPixels + $halfVerticalLength;
# Find the coordinates of the opposite corner of the square
$squareStopXPosPixels = $blockEdgeXPosPixels;
$squareStopYPosPixels = $blockEdgeYPosPixels - $halfVerticalLength;
}
return (
$squareStartXPosPixels, $squareStartYPosPixels,
$squareStopXPosPixels, $squareStopYPosPixels
);
} else {
# We already have the coordinates of opposite ends of a square
return (
$exitStartXPosPixels, $exitStartYPosPixels,
$blockEdgeXPosPixels, $blockEdgeYPosPixels
);
}
}
sub findPerpendicular {
# Called by $self->drawPickableOrnament, etc
# Finds the coordinates of the pixels at each end of a line, drawn perpendicular
# to an exit line (whose vector we know)
# The perpendicular line runs parallel with another perpendicular line, close to it
#
# Expected arguments
# $vectorRef - The vector of the exit line - a list reference, from a value in
# $self->constVectorHash
# $perpVectorRef - The vector of the perpendicular - a list reference, from a value in
# $self->constPerpVectorHash
# $factor - Set to 1 or -1, which helps us to draw two perpendicular lines,
# parallel to each other and slightly separated
# $exitMiddleXPosPixels, $exitMiddleYPosPixels
# - The coordinates of the pixel in the middle of the exit line
#
# Optional arguments
# $regionmapObj
# - The regionmap to use. If not specified, $self->currentRegionmap is
# used
#
# Return values
# An empty list on improper arguments
# Otherwise, returns the coordinates of the two pixels as a list in the form
# (startX, startY, stopX, stopY)
my (
$self, $vectorRef, $perpVectorRef, $factor, $exitMiddleXPosPixels,
$exitMiddleYPosPixels, $regionmapObj, $check,
) = @_;
# Local variables
my (
$startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels,
@emptyList,
);
# Check for improper arguments
if (
! defined $vectorRef || ! defined $perpVectorRef || ! defined $factor
|| ! defined $exitMiddleXPosPixels || ! defined $exitMiddleXPosPixels || defined $check
) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findPerpendicular', @_);
return @emptyList;
}
# Use the current regionmap, if none specified
if (! $regionmapObj) {
$regionmapObj = $self->currentRegionmap;
}
# Find the ends of the perpendicular line
$startXPosPixels =
$exitMiddleXPosPixels + ($$vectorRef[0] * $factor) + (
$$perpVectorRef[0] * int(
($regionmapObj->blockWidthPixels - $regionmapObj->roomWidthPixels) / 3
)
);
$startYPosPixels =
$exitMiddleYPosPixels + ($$vectorRef[1] * $factor) + (
$$perpVectorRef[1] * int(
($regionmapObj->blockHeightPixels - $regionmapObj->roomHeightPixels) / 3
)
);
$stopXPosPixels =
$exitMiddleXPosPixels + ($$vectorRef[0] * $factor) + (
$$perpVectorRef[2] * int(
($regionmapObj->blockWidthPixels - $regionmapObj->roomWidthPixels) / 3
)
);
$stopYPosPixels =
$exitMiddleYPosPixels + ($$vectorRef[1] * $factor) + (
$$perpVectorRef[3] * int(
($regionmapObj->blockHeightPixels - $regionmapObj->roomHeightPixels) / 3
)
);
return ($startXPosPixels, $startYPosPixels, $stopXPosPixels, $stopYPosPixels);
}
sub findExitMiddle {
# Can be called by anything
# Finds the coordinates of the pixel at the middle of an exit line, given the coordinates of
# each end of the line
#
# Expected arguments
# $exitStartXPosPixels, $exitStartYPosPixels
# - The coordinates of one end of the line
# $exitStopXPosPixels, $exitStopYPosPixels
# - The coordinates of the other end of the line
#
# Return values
# An empty list on improper arguments
# Otherwise, returns the coordinates of the pixels as a list in the form
# (middleX, middleY)
my (
$self, $exitStartXPosPixels, $exitStartYPosPixels, $exitStopXPosPixels,
$exitStopYPosPixels, $check
) = @_;
# Local variables
my (
$exitMiddleXPosPixels, $exitMiddleYPosPixels,
@emptyList,
);
# Check for improper arguments
if (
! defined $exitStartXPosPixels || ! defined $exitStartYPosPixels
|| ! defined $exitStopXPosPixels || ! defined $exitStopYPosPixels || defined $check
) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findExitMiddle', @_);
return @emptyList;
}
# Find the coordinates of the middle of the exit
if ($exitStartXPosPixels != $exitStopXPosPixels) {
$exitMiddleXPosPixels = $exitStartXPosPixels + int(
($exitStopXPosPixels - $exitStartXPosPixels) / 2
);
} else {
$exitMiddleXPosPixels = $exitStartXPosPixels;
}
if ($exitStartYPosPixels != $exitStopYPosPixels) {
$exitMiddleYPosPixels = $exitStartYPosPixels + int(
($exitStopYPosPixels - $exitStartYPosPixels) / 2
);
} else {
$exitMiddleYPosPixels = $exitStartYPosPixels;
}
return ($exitMiddleXPosPixels, $exitMiddleYPosPixels);
}
sub findMouseOverRoom {
# Called by $self->stopDrag (only)
# When a draggable exit has been dragged somewhere (and the mouse button has been released),
# work out whether the mouse was released over a room that wasn't the draggable exit's
# parent room (if so, we can connect the exit to room) or its existing destination room
#
# Expected arguments
# $clickXPosPixels, $clickYPosPixels
# - The coordinates of the mouse over the map when the mouse button was
# released
# $exitObj - The GA::Obj::Exit that was being dragged
#
# Return values
# 'undef' on improper arguments, if the drag operation didn't stop over a room, or if the
# room is the exit's parent room
# Otherwise, returns the blessed reference of the room to which the exit can be connected
my ($self, $clickXPosPixels, $clickYPosPixels, $exitObj, $check) = @_;
# Local variables
my (
$parentRoomObj, $existDestRoomObj, $xBlocks, $yBlocks, $destRoomNum, $destRoomObj,
$exitMode, $startX, $startY, $stopX, $stopY,
);
# Check for improper arguments
if (
! defined $clickXPosPixels || ! defined $clickYPosPixels || ! defined $exitObj
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findMouseOverRoom', @_);
}
# Get the exit's parent room and existing destination room
$parentRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
if ($exitObj->destRoom) {
$existDestRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->destRoom);
}
# Get the gridblock over which the mouse is positioned
($xBlocks, $yBlocks)
= $self->findGridBlock($clickXPosPixels, $clickYPosPixels, $self->currentRegionmap);
# Fetch the room at that gridblock, if any
$destRoomNum = $self->currentRegionmap->fetchRoom(
$xBlocks,
$yBlocks,
$self->currentRegionmap->currentLevel,
);
if (! $destRoomNum) {
# No room at this location
return undef;
} else {
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $destRoomNum);
if (
$destRoomObj eq $parentRoomObj
|| ($existDestRoomObj && $destRoomObj eq $existDestRoomObj)
) {
# Can't connect a draggable exit to its own room or to its existing destination
# room (if any)
return undef;
}
}
# Get the current exit drawing mode. GA::Obj::WorldModel->drawExitMode is one of the values
# 'ask_regionmap', 'no_exit', 'simple_exit' and 'complex_exit'
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $self->currentRegionmap->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# Find the coordinates of the pixel at the top-left corner of the room's border
if ($exitMode eq 'no_exit') {
# Draw exit mode 'no_exit': The room takes up the whole gridblock
($startX, $startY) = (0, 0);
} else {
# Draw exit mode 'simple_exit'/'complex_exit': The room takes up the central part of the
# gridblock
($startX, $startY) = $self->getBorderCorner(
0, # $roomObj->xPosBlocks,
0, # $roomObj->yPosBlocks,
0, # $blockCornerXPosPixels,
0, # $blockCornerYPosPixels,
$self->currentRegionmap,
);
}
# Find the coordinates of the pixel at the bottom-right of the room's border
if ($exitMode eq 'no_exit') {
# Delete 2 pixels to allow a 1-pixel border on each side of the room box; otherwise,
# the room's borders touch and will look like double-width lines
$stopX = $startX + $self->currentRegionmap->blockWidthPixels - 3;
$stopY = $startY + $self->currentRegionmap->blockHeightPixels - 3;
# In draw exit modes 'simple_exit'/'complex_exit', the room takes up the middle part of the
# gridblock
} else {
$stopX = $startX + $self->currentRegionmap->roomWidthPixels - 1;
$stopY = $startY + $self->currentRegionmap->roomHeightPixels - 1;
}
# The mouse button was released over a gridblock containing a suitable room. Was the mouse
# over the room itself, or in the surrounding empty space?
if (
$clickXPosPixels >= (
$startX + ($xBlocks * $self->currentRegionmap->blockWidthPixels)
) && $clickXPosPixels <= (
$stopX + ($xBlocks * $self->currentRegionmap->blockWidthPixels)
) && $clickYPosPixels >= (
$startY + ($yBlocks * $self->currentRegionmap->blockHeightPixels)
) && $clickYPosPixels <= (
$stopY + ($yBlocks * $self->currentRegionmap->blockHeightPixels)
)
) {
# Mouse button was released over a suitable destination room
return $destRoomObj;
} else {
# Mouse button was not release over a suitable destination room
return undef;
}
}
sub findExitClick {
# Called by $self->addBendCallback and ->findExitBend
# After a right-click on an exit, when the user has selected 'add bend' in the popup menu,
# find the position of the click relative to the start of the middle (bending) section of
# the drawn exit (the bending section starts at the same position, that an uncertain exit
# would end). Returns the relative position of the click, as well as the absolute
# position of the start and end of the bending section
# (When called by ->findExitBend, process a left-mouse click)
#
# Expected arguments
# $exitObj - The exit that was right-clicked
# $clickXPos, $clickYPos - The position of the mouse click on the canvas
#
# Return values
# An empty list on improper arguments or if the relative coordinates can't be found
# Otherwise returns a list of coordinates in the form
# (
# start_section_x, start_section_y,
# mouse_click_x, mouse_click_y,
# end_section_x, end_section_y,
# result_type,
# )
# ...where 'start_section_x', 'start_section_y' are absolute coordinates of the start
# of the bending section, and where 'mouse_click_x', 'mouse_click_y', 'end_section_x'
# and 'end_section_y' are coordinates relative to the start, and 'result_type' gives
# more information about the click:
#
# 'parent_block' if the click took place in the parent room's gridblock
# 'dest_block' if the click took place in the destination room's gridblock
# 'near_bend' if the click took place close enough to an existing bend, that no
# additional bend can be added there
# 'undef' otherwise
my ($self, $exitObj, $clickXPos, $clickYPos, $check) = @_;
# Local variables
my (
$mapDir, $exitMode, $roomObj, $xPos, $yPos, $posnListRef, $destRoomObj, $destXPos,
$destYPos, $oppDir, $oppPosnListRef, $resultType, $bendSize,
@emptyList, @returnList, @offsetList,
);
# Check for improper arguments
if (! defined $exitObj || ! defined $clickXPos || ! defined $clickYPos || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findExitClick', @_);
return @emptyList;
}
# Fetch the equivalent primary direction (the direction in which the exit is drawn on the
# map)
$mapDir = $exitObj->mapDir;
if (! $mapDir) {
return @emptyList;
}
# Get the current exit drawing mode. GA::Obj::WorldModel->drawExitMode is one of the values
# 'ask_regionmap', 'no_exit', 'simple_exit' and 'complex_exit'. The regionmap's
# ->drawExitMode is any of those values except 'ask_regionmap'
if ($self->worldModelObj->drawExitMode eq 'ask_regionmap') {
$exitMode = $self->currentRegionmap->drawExitMode;
} else {
$exitMode = $self->worldModelObj->drawExitMode;
}
# Get the exit's parent room
$roomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
# Get the position of $roomObj's gridblock
$xPos = $roomObj->xPosBlocks * $self->currentRegionmap->blockWidthPixels;
$yPos = $roomObj->yPosBlocks * $self->currentRegionmap->blockHeightPixels;
# Get the coordinates of this exit, if it were drawn as an uncertain exit (to make sure the
# coordinates are correct for this $exitMode, call ->preDrawExits)
$self->preDrawExits($exitMode);
$posnListRef = $self->ivShow('preDrawnUncertainExitHash', $mapDir);
push (@returnList,
($xPos + $$posnListRef[2]), # start_section_x
($yPos + $$posnListRef[3]), # start_section_y
($clickXPos - ($xPos + $$posnListRef[2])), # mouse_click_x
($clickYPos - ($yPos + $$posnListRef[3])), # mouse_click_y
);
# Get the destination room and its gridblock's position
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->destRoom);
$destXPos = $destRoomObj->xPosBlocks * $self->currentRegionmap->blockWidthPixels;
$destYPos = $destRoomObj->yPosBlocks * $self->currentRegionmap->blockHeightPixels;
# Now find the absolute coordinates of the end of the bending section of the exit
$oppDir = $axmud::CLIENT->ivShow('constOppDirHash', $exitObj->mapDir);
$oppPosnListRef = $self->ivShow('preDrawnUncertainExitHash', $oppDir);
push (@returnList,
(($destXPos + $$oppPosnListRef[0]) - ($xPos + $$posnListRef[2])),
(($destYPos + $$oppPosnListRef[1]) - ($yPos + $$posnListRef[3])),
);
# Find out if the click took place inside the parent or destination rooms' gridblocks, and
# if the click is close to an existing exit bend
if (
$clickXPos >= $xPos
&& $clickXPos < ($xPos + $self->currentRegionmap->blockWidthPixels)
&& $clickYPos >= $yPos
&& $clickYPos < ($yPos + $self->currentRegionmap->blockHeightPixels)
) {
# Click took place inside the parent room's gridblock
$resultType = 'parent_block';
} elsif (
$clickXPos >= $destXPos
&& $clickXPos < ($destXPos + $self->currentRegionmap->blockWidthPixels)
&& $clickYPos >= $destYPos
&& $clickYPos < ($destYPos + $self->currentRegionmap->blockHeightPixels)
) {
# Click took place inside the destination room's gridblock
$resultType = 'dest_block';
} else {
# Check the click against the position of any of the exit's existing bends
if ($exitObj->bendOffsetList) {
@offsetList = $exitObj->bendOffsetList;
$bendSize = $self->exitBendSize;
do {
my ($offsetXPos, $offsetYPos);
# Convert the bend's relative coordinates, stored in @offsetList in the form
# (x, y, x, y...), into absolute coordinates
$offsetXPos = (shift @offsetList) + $returnList[0];
$offsetYPos = (shift @offsetList) + $returnList[1];
if (
$clickXPos >= ($offsetXPos - ($bendSize * 3))
&& $clickXPos < ($offsetXPos + ($bendSize * 3))
&& $clickYPos >= ($offsetYPos - ($bendSize * 3))
&& $clickYPos < ($offsetYPos + ($bendSize * 3))
) {
# Click took place close enough to a bend, that no additional bend can be
# added at this point
$resultType = 'near_bend';
# Don't check any remaining bends
@offsetList = ();
}
} until (! @offsetList);
}
}
push (@returnList, $resultType);
# Return the coordinates
return @returnList;
}
sub findExitBend {
# Called by $self->removeBendCallback and ->startDrag
# After a mouse click on an exit, find the bend at (or very close) to the mouse click, and
# return its number. The first bend in the list is #0, the second is #1, etc
#
#
# Expected arguments
# $exitObj - The clicked GA::Obj::Exit
# $xPos, $yPos - The position of the mouse click on the canvas
#
# Return values
# 'undef' on improper arguments, if the exit has no bends or if the mouse click was not
# close enough to a bend
# Otherwise, returns the number of the bend (the bend nearest to the start of the exit
# is numbered 0)
my ($self, $exitObj, $xPos, $yPos, $check) = @_;
# Local variables
my (
$startXPos, $startYPos, $clickXPos, $clickYPos, $number, $count,
@offsetList,
);
# Check for improper arguments
if (! defined $exitObj || ! defined $xPos || ! defined $yPos || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findExitBend', @_);
}
if (! $exitObj->bendOffsetList) {
# Exit has no bends
return undef;
}
# Get the absolute coordinates of the start of the middle (bending) section of the
# exit, and the coordinates of the mouse click relative to the start
($startXPos, $startYPos, $clickXPos, $clickYPos)
= $self->findExitClick($exitObj, $xPos, $yPos);
# Check every drawn bend on the exit, looking for one which is close enough to the mouse
# click
@offsetList = $exitObj->bendOffsetList;
$number = scalar @offsetList;
$count = -1;
do {
my ($xPos, $yPos);
$xPos = shift @offsetList;
$yPos = shift @offsetList;
$count++;
if (
(abs ($clickXPos - $xPos)) <= ($self->exitBendSize * 2)
&& (abs ($clickYPos - $yPos)) <= ($self->exitBendSize * 2)
) {
# Bend found
return $count;
}
} until (! @offsetList);
# No bend found
return undef;
}
# Compilation/check functions
sub compileSelectedRooms {
# Called by several menu/callback functions
# Returns a list of selected rooms, combining the contents of $self->selectedRoom and
# ->selectedRoomHash
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments, if there is no current regionmap or if
# $self->selectedRoom and ->selectedRoomHash are both empty
# Otherwise, returns a list containing blessed references to the GA::ModelObj::Room
# objects stored in $self->selectedRoom or $self->selectedRoomHash
my ($self, $check) = @_;
# Local variables
my (@emptyList, @returnList);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->compileSelectedRooms', @_);
return @emptyList;
}
# No selected rooms if there's no regionmap
if (! $self->currentRegionmap) {
return @emptyList;
}
# Compile selected rooms
if ($self->selectedRoom) {
push (@returnList, $self->selectedRoom);
}
if ($self->selectedRoomHash) {
push (@returnList, $self->ivValues('selectedRoomHash'));
}
return @returnList;
}
sub compileSelectedRoomTags {
# Called by several menu/callback functions
# Returns a list of selected room tags, combining the contents of $self->selectedRoomTag
# and ->selectedRoomTagHash
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments, if there is no current regionmap or if
# $self->selectedRoomTag and ->selectedRoomTagHash are both empty
# Otherwise, returns a list containing blessed references to the GA::ModelObj::Room
# objects (all of which have room tags) stored in $self->selectedRoomTag or
# $self->selectedRoomTagHash
my ($self, $check) = @_;
# Local variables
my (@emptyList, @returnList);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->compileSelectedRoomTags', @_);
return @emptyList;
}
# No selected room tags if there's no regionmap
if (! $self->currentRegionmap) {
return @emptyList;
}
# Compile selected room tags
if ($self->selectedRoomTag) {
push (@returnList, $self->selectedRoomTag);
}
if ($self->selectedRoomTagHash) {
push (@returnList, $self->ivValues('selectedRoomTagHash'));
}
return @returnList;
}
sub compileSelectedRoomGuilds {
# Called by several menu/callback functions
# Returns a list of selected room guilds, combining the contents of $self->selectedRoomGuild
# and ->selectedRoomGuildHash
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments, if there is no current regionmap or if
# $self->selectedRoomGuild and ->selectedRoomGuildHash are both empty
# Otherwise, returns a list containing blessed references to the GA::ModelObj::Room
# objects (all of which have room guilds) stored in $self->selectedRoomGuild or
# $self->selectedRoomGuildHash
my ($self, $check) = @_;
# Local variables
my (@emptyList, @returnList);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->compileSelectedRoomGuilds', @_);
return @emptyList;
}
# No selected room guilds if there's no regionmap
if (! $self->currentRegionmap) {
return @emptyList;
}
# Compile selected room guilds
if ($self->selectedRoomGuild) {
push (@returnList, $self->selectedRoomGuild);
}
if ($self->selectedRoomGuildHash) {
push (@returnList, $self->ivValues('selectedRoomGuildHash'));
}
return @returnList;
}
sub compileSelectedExits {
# Called by several menu/callback functions
# Returns a list of selected exits, combining the contents of $self->selectedExit and
# ->selectedExitHash
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments, if there is no current regionmap or if
# $self->selectedExit and ->selectedExitHash are both empty
# Otherwise, returns a list containing blessed references to the GA::Obj::Exit objects
# stored in $self->selectedExit or $self->selectedExitHash
my ($self, $check) = @_;
# Local variables
my (@emptyList, @returnList);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->compileSelectedExits', @_);
return @emptyList;
}
# No selected exits if there's no regionmap
if (! $self->currentRegionmap) {
return @emptyList;
}
# Compile selected exits
if ($self->selectedExit) {
push (@returnList, $self->selectedExit);
}
if ($self->selectedExitHash) {
push (@returnList, $self->ivValues('selectedExitHash'));
}
return @returnList;
}
sub compileSelectedExitTags {
# Called by several menu/callback functions
# Returns a list of selected exit tags, combining the contents of $self->selectedExitTag
# and ->selectedExitTagHash
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments, if there is no current regionmap or if
# $self->selectedExitTag and ->selectedExitTagHash are both empty
# Otherwise, returns a list containing blessed references to the GA::Obj::Exit objects
# (all of which have exit tags) stored in $self->selectedExitTag or
# $self->selectedExitTagHash
my ($self, $check) = @_;
# Local variables
my (@emptyList, @returnList);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->compileSelectedExitTags', @_);
return @emptyList;
}
# No selected exit tags if there's no regionmap
if (! $self->currentRegionmap) {
return @emptyList;
}
# Compile selected exit tags
if ($self->selectedExitTag) {
push (@returnList, $self->selectedExitTag);
}
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
) = @_;
# Check for improper arguments
if (
! defined $clickXPosPixels || ! defined $clickYPosPixels || ! defined $startXPosPixels
|| ! defined $startYPosPixels || ! defined $stopXPosPixels || ! defined $stopYPosPixels
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->checkCredibleExit', @_);
}
# Do the credibility check
if (
(
$startXPosPixels < $stopXPosPixels && (
$clickXPosPixels < $startXPosPixels || $clickXPosPixels > $stopXPosPixels
)
) || (
$startXPosPixels > $stopXPosPixels && (
$clickXPosPixels > $startXPosPixels || $clickXPosPixels < $stopXPosPixels
)
) || (
$startYPosPixels < $stopYPosPixels && (
$clickYPosPixels < $startYPosPixels || $clickYPosPixels > $stopYPosPixels
)
) || (
$startYPosPixels > $stopYPosPixels && (
$clickYPosPixels > $startYPosPixels || $clickYPosPixels < $stopYPosPixels
)
)
) {
# The mouse click is too far away from the exit to be worth checking more precisely
return undef;
} else {
# The mouse click is credibly close to the exit to be worth checking more preciselhy
return 1;
}
}
# Prompt functions ('dialogue' windows unique to the Automapper window)
sub promptGridBlock {
# Called by $self->addRoomAtBlockCallback or ->addLabelAtBlockCallback
# Prompts the user to enter a gridblock via a 'dialogue' window, and returns the gridblock
# entered
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments or if the user clicks the 'cancel' button
# Otherwise returns a list in the form (x, y, z)
my ($self, $check) = @_;
# Local variables
my (
$response, $xPosBlocks, $yPosBlocks, $zPosBlocks,
@emptyList,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->promptGridBlock', @_);
return @emptyList;
}
# Show the 'dialogue' window
my $dialogueWin = Gtk3::Dialog->new(
'Select gridblock',
$self->winWidget, # Parent window is this window
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);
# X co-ordinate
my $labelX = Gtk3::Label->new();
$vBox2->pack_start($labelX, FALSE, FALSE, 5);
$labelX->set_alignment(0, 0);
$labelX->set_markup(
'X co-ordinate (0-' . ($self->currentRegionmap->gridWidthBlocks - 1) . ')'
);
my $entryX = Gtk3::Entry->new();
$vBox2->pack_start($entryX, FALSE, FALSE, 5);
# Y co-ordinate
my $labelY = Gtk3::Label->new;
$vBox2->pack_start($labelY, FALSE, FALSE, 5);
$labelY->set_alignment(0, 0);
$labelY->set_markup(
'Y co-ordinate (0-' . ($self->currentRegionmap->gridHeightBlocks - 1) . ')'
);
my $entryY = Gtk3::Entry->new();
$vBox2->pack_start($entryY, FALSE, FALSE, 5);
# Z co-ordinate
my $labelZ = Gtk3::Label->new;
$vBox2->pack_start($labelZ, FALSE, FALSE, 5);
$labelZ->set_alignment(0, 0);
$labelZ->set_markup(
'Z co-ordinate (any value)'
);
my $entryZ = Gtk3::Entry->new();
$vBox2->pack_start($entryZ, FALSE, FALSE, 5);
# As a timesaver, enter the currently displayed level (if any)
if ($self->currentRegionmap) {
$entryZ->set_text($self->currentRegionmap->currentLevel);
}
# Display the dialogue
$vBox->show_all();
# Get the response. If the user clicked 'cancel', $response will be 'reject'
# Otherwise, user clicked 'ok', and we need to get the contents of the three boxes
$response = $dialogueWin->run();
if ($response eq 'accept') {
$xPosBlocks = $entryX->get_text();
$yPosBlocks = $entryY->get_text();
$zPosBlocks = $entryZ->get_text();
$dialogueWin->destroy();
$self->restoreFocus();
return ($xPosBlocks, $yPosBlocks, $zPosBlocks);
} else {
$dialogueWin->destroy();
$self->restoreFocus();
return @emptyList;
}
}
sub promptNewRegion {
# Called by $self->newRegionCallback
# Prompts the user to enter a region name, parent region and size, and returns the values
# entered
#
# Expected arguments
# $tempFlag - FALSE for a normal region, or TRUE for a temporary region
#
# Return values
# On improper arguments or if the user clicks the cancel button, returns an empty list
# Otherwise returns a list in the form:
# (success_flag, region_name, parent_region_name, width_height)
# ...where 'success_flag' is TRUE, and 'region_name' and/or 'parent_region_name' are
# 'undef' or a non-empty string
my ($self, $tempFlag, $check) = @_;
# Local variables
my (
$title, $spacing, $noParentString, $response, $name, $parentName, $string, $width,
$height,
@emptyList, @objList, @comboList, @sizeList, @comboList2,
%widthHash, %heightHash,
);
# Check for improper arguments
if (! defined $tempFlag || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->promptNewRegion', @_);
return @emptyList;
}
# Set the 'dialogue' window title
if ($tempFlag) {
$title = 'New temporary region';
} else {
$title = 'New region';
}
# Set the correct spacing size for 'dialogue' windows
$spacing = $axmud::CLIENT->constFreeSpacingPixels;
# Get a sorted list of region objects
@objList = sort {lc($a->name) cmp lc($b->name)}
($self->worldModelObj->ivValues('regionModelHash'));
# Convert this list into region names
foreach my $obj (@objList) {
push (@comboList, $obj->name);
}
# The first item on the list should be an option to choose no parent at all
$noParentString = '<no parent region>';
unshift(@comboList, $noParentString);
# Prepare a list of map sizes
@sizeList = (
'Default (' . $self->worldModelObj->defaultGridWidthBlocks . ' x '
. $self->worldModelObj->defaultGridHeightBlocks. ')',
$self->worldModelObj->defaultGridWidthBlocks,
$self->worldModelObj->defaultGridHeightBlocks,
'Minuscule (5 x 5)',
5,
5,
'Tiny (11 x 11)',
11,
11,
'Very small (21 x 21)',
21,
21,
'Small (51 x 51)',
51,
51,
'Compact (101 x 101)',
101,
101,
'Normal (201 x 201)',
201,
201,
'Large (501 x 501)',
501,
501,
'Enormous (1001 x 1001)',
1001,
1001,
);
do {
my ($descrip, $width, $height);
$descrip = shift @sizeList;
$width = shift @sizeList;
$height = shift @sizeList;
# (The maximum size of a map shouldn't change, but check anyway)
if (
$width <= $self->worldModelObj->maxGridWidthBlocks
&& $height <= $self->worldModelObj->maxGridHeightBlocks
) {
push (@comboList2, $descrip);
$widthHash{$descrip} = $width;
$heightHash{$descrip} = $height;
}
} until (! @sizeList);
# 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 $label = Gtk3::Label->new();
$vBox2->pack_start($label, FALSE, FALSE, $spacing);
$label->set_alignment(0, 0);
$label->set_markup(
"Enter a name for the new region (max 32 chars),\n"
. "or leave empty to generate a generic name",
);
my $entry = Gtk3::Entry->new();
$vBox2->pack_start($entry, FALSE, FALSE, $spacing);
$entry->set_max_length(32);
my $label2 = Gtk3::Label->new();
$vBox2->pack_start($label2, FALSE, FALSE, $spacing);
$label2->set_alignment(0, 0);
$label2->set_markup('(Optional) select the parent region');
my $combo = Gtk3::ComboBoxText->new();
$vBox2->pack_start($combo, FALSE, FALSE, $spacing);
foreach my $item (@comboList) {
$combo->append_text($item);
}
$combo->set_active(0);
if ((scalar @comboList) == 1) {
# No regions exist, so no need to offer a parent region
$combo->set_sensitive(FALSE);
}
my $label3 = Gtk3::Label->new();
$vBox2->pack_start($label3, FALSE, FALSE, $spacing);
$label3->set_alignment(0, 0);
$label3->set_markup('(Optional) change the map size');
my $combo2 = Gtk3::ComboBoxText->new();
$vBox2->pack_start($combo2, FALSE, FALSE, $spacing);
foreach my $item (@comboList2) {
$combo2->append_text($item);
}
$combo2->set_active(0);
# Display the 'dialogue' window
$vBox->show_all();
# Get the response
$response = $dialogueWin->run();
# If the user clicked 'cancel', $response will be 'reject'
if ($response ne 'accept') {
$dialogueWin->destroy();
# Restore focus to the Automapper window
$self->restoreFocus();
return @emptyList;
# Otherwise, user clicked 'ok', and we need to interpret the values types
} else {
$name = $entry->get_text();
if ($name eq '') {
$name = undef;
}
$parentName = $combo->get_active_text();
if ($parentName eq $noParentString) {
$parentName = undef;
}
$string = $combo2->get_active_text();
$width = $widthHash{$string};
$height = $heightHash{$string};
# Destroy the 'dialogue' window
$dialogueWin->destroy();
# Restore focus to the Automapper window
$self->restoreFocus();
# Return the specified data
return (TRUE, $name, $parentName, $width, $height);
}
}
sub promptNewExit {
# Called by $self->addExitCallback, ->changeDirCallback or ->setAssistedMoveCallback
# Prompts the user to enter a primary (and nominal) direction for an exit, and returns the
# directions entered
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room to which a new exit is about to be added
# $title - The 'dialogue' window title - 'Add exit' or 'Change exit'
#
# Optional arguments
# $exitObj - When not called by $self->addExitCallback, the existing GA::Obj::Exit
# $mode - Set to 'change_dir' when called by $self->changeDirCallback, set to
# 'set_assist' when called by $self->setAssistedMoveCallback (set to
# 'undef' when called by ->addExitCallback)
#
# Return values
# On improper arguments or if the user clicks the cancel button, returns an empty list
# Otherwise returns a list of two or four elements, some of which may be 'undef':
# (nominal_direction, map_direction, profile, assisted_move_for_this_profile)
my ($self, $roomObj, $title, $exitObj, $mode, $check) = @_;
# Local variables
my (
$standardDir, $nominalDir, $assistedProf, $assistedMove, $match, $response,
@emptyList, @shortList, @longList, @extraList, @dirList, @availableList, @profList,
%checkHash,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $title || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->promptNewExit', @_);
return @emptyList;
}
# 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(
north northeast east southeast south southwest west northwest up down
northnortheast eastnortheast eastsoutheast southsoutheast
southsouthwest westsouthwest westnorthwest northnorthwest
);
# If none of the eight usual cardinal directions are available, then the user must be
# offered 'northnortheast', etc. These IVs are used to check for that possibility
@extraList = qw(
northnortheast eastnortheast eastsoutheast southsoutheast
southsouthwest westsouthwest westnorthwest northnorthwest
);
%checkHash = (
'north' => undef,
'northeast' => undef,
'east' => undef,
'southeast' => undef,
'south' => undef,
'southwest' => undef,
'west' => undef,
'northwest' => undef,
);
if ($self->worldModelObj->showAllPrimaryFlag) {
@dirList = @longList;
} else {
@dirList = @shortList;
}
# Extract all the available (standard) primary directions (those not in use by other exits)
OUTER: foreach my $dir (@dirList) {
INNER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $thisExitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if (
$thisExitObj->mapDir
&& $thisExitObj->mapDir eq $dir
&& $thisExitObj->drawMode ne 'temp_alloc'
&& $thisExitObj->drawMode ne 'temp_unalloc'
) {
# $dir isn't available
if (exists $checkHash{$dir}) {
delete $checkHash{$dir};
}
next OUTER;
}
}
# $dir is available
push (@availableList, $dir);
}
# If the eight usual cardinal directions are not available, then the user must be offered
# 'northnortheast', etc, even if ->showAllPrimaryFlag is not set
if (! $self->worldModelObj->showAllPrimaryFlag && ! %checkHash) {
OUTER: foreach my $dir (@extraList) {
INNER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $thisExitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if (
$thisExitObj->mapDir
&& $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('');
}
});
}
# Display the dialogue
$vBox->show_all();
# Get the response
$response = $dialogueWin->run();
# If the user clicked 'cancel', $response will be 'reject'
if ($response ne 'accept') {
$dialogueWin->destroy();
# Restore focus to the Automapper window
$self->restoreFocus();
return @emptyList;
# Otherwise, user clicked 'ok', and we need to get the coordinates typed
} else {
if ($comboBox && $entry) {
$standardDir = $comboBox->get_active_text();
$nominalDir = $entry->get_text();
# If the entry box is empty, the nominal direction is the same as the standard
# direction (it shouldn't be empty, but the user might try to empty it anyway)
if (! $nominalDir) {
$nominalDir = $self->session->currentDict->ivShow(
'primaryDirHash',
$standardDir,
);
# If a nominal direction was supplied, make sure it's not an abbreviated primary/
# secondary direction
} else {
$nominalDir = $self->session->currentDict->unabbrevDir($nominalDir);
}
}
if ($comboBox2 && $entry2) {
$assistedProf = $comboBox2->get_active_text();
$assistedMove = $entry2->get_text();
}
# Destroy the 'dialogue' window
$dialogueWin->destroy();
# Restore focus to the Automapper window
$self->restoreFocus();
# Return the specified data
return ($nominalDir, $standardDir, $assistedProf, $assistedMove);
}
}
sub promptMultipleExits {
# Called by $self->addMultipleExitsCallback
# Prompts the user to add one or more exits in primary directions to the currently selected
# room(s)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $roomObj - If a single room is selected, that room (in which case the dialogue
# window checks the room's existing exits, and doesn't ask the user to
# create exits in directions that already exist)
#
# Return values
# On improper arguments, if the user clicks the cancel button or if there are no available
# primary directions, returns an empty list
# Otherwise returns a list in the form
# (hidden_flag, custom_dir, custom_dir, custom_dir...)
# ...where 'hidden_flag' is TRUE if the exits should be hidden, FALSE if not, and
# 'custom_dir' is any number (including 0) of custom primary directions
my ($self, $roomObj, $check) = @_;
# Local variables
my (
$count, $response,
@emptyList, @dirList, @widgetList, @returnList,
%availableHash, %useDirHash,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->promptMultipleExits', @_);
return @emptyList;
}
if ($self->worldModelObj->showAllPrimaryFlag) {
@dirList = $axmud::CLIENT->constPrimaryDirList;
} else {
@dirList = $axmud::CLIENT->constShortPrimaryDirList;
}
# Extract all the available primary directions (those not in use by other exits)
OUTER: foreach my $standardDir (@dirList) {
# Get the custom primary direction
my $customDir = $self->session->currentDict->ivShow('primaryDirHash', $standardDir);
# If a single room is selected, don't show exits in directions that alreadyd exist
if ($roomObj) {
INNER: foreach my $number ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $number);
if (
$exitObj->mapDir
&& $exitObj->mapDir eq $standardDir
&& $exitObj->drawMode ne 'temp_alloc'
&& $exitObj->drawMode ne 'temp_unalloc'
) {
# The primary direction isn't available
next OUTER;
}
}
}
# $customDir can be shown in the 'dialogue' window
$availableHash{$standardDir} = $customDir;
}
if (! %availableHash) {
$self->showMsgDialogue(
'Add multiple exits',
'warning',
'The selected room already has exits drawn in all primary directions',
'ok',
);
return @emptyList;
}
# That completes the setup. Now, show the 'dialogue' window
my $dialogueWin = Gtk3::Dialog->new(
'Add multiple exits',
$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});
# Destroy the window, when required
$dialogueWin->signal_connect('delete-event' => sub {
$dialogueWin->destroy();
$self->restoreFocus();
return undef;
});
# 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 a table, and arrange widgets on it
my $table = Gtk3::Grid->new();
$vBox2->pack_start($table, TRUE, TRUE, $axmud::CLIENT->constFreeSpacingPixels);
$table->set_column_spacing($axmud::CLIENT->constFreeSpacingPixels);
$table->set_row_spacing($axmud::CLIENT->constFreeSpacingPixels);
my $label = Gtk3::Label->new();
$table->attach($label, 0, 0, 3, 1);
$label->set_alignment(0, 0);
if ($self->selectedRoom) {
$label->set_markup('<i>Add exits to 1 selected room</i>');
} else {
$label->set_markup(
'<i>Add exits to ' . $self->ivPairs('selectedRoomHash') . ' selected rooms</i>',
);
}
$count = 0;
foreach my $dir (
qw (
north northeast east southeast south southwest west northwest
up
northnortheast eastnortheast eastsoutheast southsoutheast southsouthwest
westsouthwest westnorthwest northnorthwest
down
)
) {
$count++;
my $checkButton = Gtk3::CheckButton->new_with_label($dir);
if ($count <= 9) {
$table->attach($checkButton, 0, $count, 1, 1);
} else {
$table->attach($checkButton, 1, ($count - 9), 2, 1);
}
$checkButton->signal_connect('toggled' => sub {
if ($checkButton->get_active()) {
$useDirHash{$dir} = undef;
} elsif (exists $useDirHash{$dir}) {
delete $useDirHash{$dir};
}
});
if (! exists $availableHash{$dir}) {
$checkButton->set_sensitive(FALSE);
}
push (@widgetList, $checkButton);
}
# Add two buttons at the bottom to select all/no available directions, and to specify
# hidden exits
my $button = Gtk3::Button->new('Select all');
$table->attach($button, 0, 10, 2, 1);
$button->signal_connect('clicked' => sub {
foreach my $checkButton (@widgetList) {
if ($checkButton->get_sensitive()) {
$checkButton->set_active(TRUE);
}
}
});
my $button2 = Gtk3::Button->new('Select none');
$table->attach($button2, 2, 10, 1, 1);
$button2->signal_connect('clicked' => sub {
foreach my $checkButton (@widgetList) {
if ($checkButton->get_sensitive()) {
$checkButton->set_active(FALSE);
}
}
});
my $button3 = Gtk3::CheckButton->new_with_label('Add these exits as hidden exits');
$table->attach($button3, 0, 11, 3, 1);
# Add a seperator above the OK/Cancel buttons
my $separator = Gtk3::HSeparator->new();
$vBox2->pack_start($separator, FALSE, FALSE, 10);
# Display the dialogue
$vBox->show_all();
# Get the response
$response = $dialogueWin->run();
# If the user clicked 'cancel', $response will be 'reject'
if ($response ne 'accept') {
$dialogueWin->destroy();
$self->restoreFocus();
return @emptyList;
# Otherwise, user clicked 'ok', and we need to get an ordered list of selected directions
} else {
foreach my $dir (@dirList) {
if (exists $useDirHash{$dir}) {
push (@returnList, $dir);
}
}
$dialogueWin->destroy();
$self->restoreFocus();
if (! $button3->get_active()) {
return (FALSE, @returnList);
} else {
return (TRUE, @returnList);
}
}
}
sub promptSpecifyExit {
# Called by $self->changeDirCallback and $self->setAssistedMoveCallback
# If the selected exit has a twin and/or shadow exits, the user needs to specify the exit
# to modify
#
# Expected arguments
# $text - e.g. 'Select which exit to change'
#
# Return values
# 'undef' on improper arguments, or if the user declines to specify an exit
# If the selected exit doesn't have either twin or shadow exits, simply returns the
# blessed reference of the selected exit
# Otherwise prompts the user to choose an exit, and returns it
my ($self, $text, $check) = @_;
# Local variables
my ($stringListRef, $exitHashRef, $choice);
# Check for improper arguments
if (! defined $text || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->promptSpecifyExit', @_);
}
# Get lists of the exits linked to the selected one
($stringListRef, $exitHashRef) = $self->compileExitList();
if (! defined $stringListRef) {
return undef;
}
# If there is only one exit in the list, we don't need to prompt the user to specify which
# one to choose
if (@$stringListRef == 1) {
return $$exitHashRef{$$stringListRef[0]};
}
# Prompt the user to choose an exit
$choice = $self->showComboDialogue(
'Select exit',
$text,
$stringListRef,
);
if (! $choice) {
return undef;
} else {
# Return the blessed reference of the chosen exit
return $$exitHashRef{$choice};
}
}
sub promptFilePath {
# Called by $self->setFilePathCallback
# Prompts the user to enter a file path for the selected room and (optionally) the path
# to the virtual area, if the room is in one
#
# Expected arguments
# $roomObj - The room for which to set a file path
#
# Return values
# On improper arguments or if the user clicks the cancel button, returns an empty list
# Otherwise returns a list of two elements, in the form
# (file_path, virtual_area_path)
# If the user doesn't enter text into one or the other boxes, one (or both) elements
# will be empty strings
my ($self, $roomObj, $check) = @_;
# Local variables
my (
$msg, $msg2, $response, $filePath, $virtualPath,
@emptyList,
);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->promptFilePath', @_);
return @emptyList;
}
# Create the 'dialogue' window
my $dialogueWin = Gtk3::Dialog->new(
'Set file path',
$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);
# First label and entry
$msg = "Enter the path to the room\'s source code file in the mudlib (if known)\n";
if ($roomObj->sourceCodePath) {
$msg .= "<i>(current value: " . $roomObj->sourceCodePath . ")</i>";
} else {
$msg .= "<i>(current value: not set)</i>";
}
my $label = Gtk3::Label->new();
$vBox2->pack_start($label, FALSE, FALSE, 5);
$label->set_alignment(0, 0);
$label->set_markup($msg);
my $entry = Gtk3::Entry->new();
$vBox2->pack_start($entry, FALSE, FALSE, 5);
# Use the room's existing path, if it has one; otherwise, copy the last path entered by
# the user, so they can edit it without re-typing the whole thing
if ($roomObj->sourceCodePath) {
$entry->set_text($roomObj->sourceCodePath);
} elsif ($self->worldModelObj->lastFilePath) {
$entry->set_text($self->worldModelObj->lastFilePath);
}
# Second label and entry
$msg2 = "(Optional) Enter a path to the virtual area, if the room is in one\n";
if ($roomObj->virtualAreaPath) {
$msg2 .= "<i>(current value: " . $roomObj->virtualAreaPath . ")</i>";
} else {
$msg2 .= "<i>(current value: not set)</i>";
}
my $label2 = Gtk3::Label->new();
$vBox2->pack_start($label2, FALSE, FALSE, 5);
$label2->set_alignment(0, 0);
$label2->set_markup($msg2);
my $hBox = Gtk3::HBox->new(FALSE, 0);
$vBox->pack_start($hBox, FALSE, FALSE, 5);
my $entry2 = Gtk3::Entry->new();
$hBox->pack_start($entry2, TRUE, TRUE, 0);
# Use the room's existing virtual area path, if it has one; otherwise use the last path
# entered by the user
if ($roomObj->virtualAreaPath) {
$entry2->append_text($roomObj->virtualAreaPath);
} elsif ($self->worldModelObj->lastVirtualAreaPath) {
$entry2->append_text($self->worldModelObj->lastVirtualAreaPath);
}
# 2nd entry box starts insensitive if the 1st entry box doesn't contain text
if (! $entry->get_text()) {
$entry2->set_sensitive(FALSE);
}
my $button = Gtk3::Button->new('Copy');
$hBox->pack_start($button, TRUE, TRUE, 5);
$button->signal_connect('clicked' => sub {
# Copy the contents of the first entry into the second
$entry2->set_text($entry->get_text());
});
$button->set_tooltip_text('Copy the file path into this entry box');
# The second entry can only be edited when the first contains text
$entry->signal_connect('changed' => sub {
if (! $entry->get_text()) {
# First entry is now empty, so empty the second entry too
$entry2->set_text('');
$entry2->set_sensitive(FALSE);
} else {
# Sensitise the second entry
$entry2->set_sensitive(TRUE);
}
});
# Display the dialogue
$vBox->show_all();
# If the user clicked 'cancel', $response will be 'reject'
# Otherwise, user clicked 'ok', and we need to get the coordinates typed
$response = $dialogueWin->run();
if ($response eq 'accept') {
$filePath = $entry->get_text();
$virtualPath = $entry2->get_text();
}
$dialogueWin->destroy();
$self->restoreFocus();
return ($filePath, $virtualPath);
}
sub promptAdjacentMode {
# Called by $self->adjacentModeCallback
# Prompts the user to enter new values for GA::Obj::WorldModel->adjacentMode and
# ->adjacentCount, and returns them
#
# Expected arguments
# (none besides $self)
#
# Return values
# On improper arguments or if the user clicks the cancel button, returns an empty list
# Otherwise returns a list of two elements, in the form
# (mode, count)
my ($self, $check) = @_;
# Local variables
my (
$spacing, $first, $response, $responseText, $responseText2,
@emptyList, @list, @comboList,
%descripHash,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->promptAdjacentMode', @_);
return @emptyList;
}
# Set the correct spacing size for 'dialogue' windows
$spacing = $axmud::CLIENT->constFreeSpacingPixels;
# Show the 'dialogue' window
my $dialogueWin = Gtk3::Dialog->new(
'Adjacent regions regions mode',
$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);
# First label and combo
my $label = Gtk3::Label->new();
$vBox2->pack_start($label, FALSE, FALSE, $spacing);
$label->set_alignment(0, 0);
$label->set_markup(
"In adjacent regions mode, the pathfinding routines\n"
. "treat rooms in nearby regions as if they were all\n"
. "in the same region",
);
# Prepare the combo list. The current setting of GA::Obj::WorldModel->adjacentMode should be
# at the top
@list = (
'Don\'t use this mode' => 'default',
'Use adjacent regions' => 'near',
'Use all regions' => 'all',
);
do {
my ($descrip, $mode);
$descrip = shift @list;
$mode = shift @list;
if ($mode eq $self->worldModelObj->adjacentMode) {
$first = $descrip;
} else {
push (@comboList, $descrip);
}
$descripHash{$descrip} = $mode;
} until (! @list);
unshift (@comboList, $first);
# Fill the combo box with the specified lines, and display the first line
my $combo = Gtk3::ComboBoxText->new();
$vBox2->pack_start($combo, FALSE, FALSE, $spacing);
foreach my $line (@comboList) {
$combo->append_text($line);
}
$combo->set_active(0);
# (->signal_connect appears below)
# Second label and entry
my $label2 = Gtk3::Label->new();
$vBox2->pack_start($label2, FALSE, FALSE, $spacing);
$label2->set_alignment(0, 0);
$label2->set_markup(
"How close adjacent regions must be (e.g. 1 - regions\n"
. "must be connected, 2 - connected via intermediate\n"
. "region, 0 - don\'t use adjacent regions right now)",
);
# (Use the same maximum characters that the 'edit' window uses
my $entry = Gtk3::Entry->new();
$vBox2->pack_start($entry, FALSE, FALSE, $spacing);
$entry->set_max_length(4);
$entry->set_text($self->worldModelObj->adjacentCount);
if ($self->worldModelObj->adjacentMode ne 'near') {
$entry->set_sensitive(FALSE);
}
# (->signal_connect from above)
$combo->signal_connect('changed' => sub {
my $descrip = $combo->get_active_text();
if ($descripHash{$descrip} eq 'near') {
$entry->set_text($self->worldModelObj->adjacentCount);
$entry->set_sensitive(TRUE);
} else {
$entry->set_text('');
$entry->set_sensitive(FALSE);
}
});
# Display the 'dialogue' window. Without this combination of Gtk calls, the window is not
# consistently active (don't know why this works; it just does)
$dialogueWin->show_all();
$dialogueWin->present();
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->promptAdjacentMode');
# Get the response. If the user clicked 'cancel', $response will be 'reject'
# Otherwise, user clicked 'ok', and we need to get the contents of the two boxes
$response = $dialogueWin->run();
if (defined $response && $response eq 'accept') {
$responseText = $combo->get_active_text();
$responseText2 = $entry->get_text();
# Destroy the window
$dialogueWin->destroy();
$self->restoreFocus();
# Return the response
return ($descripHash{$responseText}, $responseText2);
} else {
# Destroy the window
$dialogueWin->destroy();
$self->restoreFocus();
# Return the response
return @emptyList;
}
}
sub promptConfigLabel {
# Called by $self->addLabelAtBlockCallback, ->addLabelAtClickCallback and
# ->setLabelCallback
# Prompts the user for some label text and an optional label style
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $labelObj - When called by ->setLabelCallback, the existing label text and style
# $customiseFlag - If FALSE, the 'dialogue' window only shows label text and style. If
# TRUE, the 'dialogue' window shows all label IVs
#
# Return values
# An empty list on improper arguments or if the user closes the window without making
# changes
# Otherwise returns a list in the form
# (label_text, label_style)
# ...where 'label_text' must contain at least one non-space character, and 'label_style'
# is the name of a label style object stored in GA::Obj::WorldModel->mapLabelStyleHash
# (or 'undef', if the label style object specified by
# GA::Obj::WorldModel->mapLabelStyle is used)
my ($self, $labelObj, $customiseFlag, $check) = @_;
# Local variables
my (
$title, $current, $response, $textColour, $underlayColour, $count, $index, $relSize,
$text, $choice, $angleFlag,
@emptyList, @list, @comboList,
%descripHash, %revDescripHash,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->promptConfigLabel', @_);
return @emptyList;
}
# Show the 'dialogue' window
if (! $customiseFlag) {
$title = 'Add label';
} else {
$title = 'Customise label';
}
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);
# First label and entry/textview
my $label = Gtk3::Label->new();
$vBox2->pack_start($label, FALSE, FALSE, 5);
$label->set_alignment(0, 0);
$label->set_markup('Enter the label text');
my ($entry, $scroller, $textView, $buffer);
# (If the label object already uses multiple lines, then we have to allow multiline input,
# even if GA::Obj::WorldModel->mapLabelTextViewFlag is turned off)
if (
! $self->worldModelObj->mapLabelTextViewFlag
&& (! $labelObj || ! ($labelObj->name =~ m/\n/))
) {
# Create an entry
$entry = Gtk3::Entry->new();
# (->signal_connect appears below)
$vBox2->pack_start($entry, FALSE, FALSE, 5);
if ($labelObj) {
$entry->set_text($labelObj->name);
}
if (! $customiseFlag) {
$entry->signal_connect('activate' => sub {
$text = $entry->get_text();
# This line ends the call to $dialogueWin->run(), as if the user had clicked the
# 'OK' button
$dialogueWin->destroy();
});
}
} else {
# Create a textview using the system's preferred colours and fonts
$scroller = Gtk3::ScrolledWindow->new(undef, undef);
$vBox2->pack_start($scroller, FALSE, FALSE, 5);
$scroller->set_shadow_type($axmud::CLIENT->constShadowType);
$scroller->set_policy('automatic', 'automatic');
$scroller->set_size_request(200, 75);
# Create a textview with default colours/fonts for a dialogue window
$textView = Gtk3::TextView->new();
$scroller->add($textView);
$buffer = Gtk3::TextBuffer->new();
$textView->set_buffer($buffer);
$textView->set_editable(TRUE);
$textView->set_cursor_visible(TRUE);
$axmud::CLIENT->desktopObj->setTextViewStyle('dialogue', $textView);
if ($labelObj) {
$buffer->set_text($labelObj->name);
}
}
my (
$label2, $combo,
$table,
$label3, $frame, $canvas, $canvasObj, $button, $button2,
$label4, $frame2, $canvas2, $canvasObj2, $button3, $button4,
$label5, $entry2,
$checkButton, $checkButton2, $checkButton3, $checkButton4, $checkButton5,
$label6, $combo2,
$entry3,
);
if (! $customiseFlag) {
# Second label and combo
$label2 = Gtk3::Label->new();
$vBox2->pack_start($label2, FALSE, FALSE, 5);
$label2->set_alignment(0, 0);
$label2->set_markup('Select a label style');
# (The world model defines a style for use with new labels; show it first in the list,
# or show the existing label's style
if ($labelObj) {
$current = $labelObj->style;
} else {
$current = $self->worldModelObj->mapLabelStyle;
}
foreach my $style (
sort {lc($a) cmp lc($b)} ($self->worldModelObj->ivKeys('mapLabelStyleHash'))
) {
if (! defined $current || $current ne $style) {
push (@comboList, $style);
}
}
if (defined $current) {
unshift(@comboList, $current);
}
$combo = Gtk3::ComboBoxText->new();
$vBox2->pack_start($combo, FALSE, FALSE, 5);
foreach my $item (@comboList) {
$combo->append_text($item);
}
$combo->set_active(0);
} else {
# Extra widgets for all map label object IVs apart from ->style (which is about to be
# reset). A lot to fit in, so we're going to need a table
$table = Gtk3::Grid->new();
$vBox2->pack_start($table, TRUE, TRUE, $axmud::CLIENT->constFreeSpacingPixels);
$table->set_column_spacing($axmud::CLIENT->constFreeSpacingPixels);
$table->set_row_spacing($axmud::CLIENT->constFreeSpacingPixels);
# Text colour
$textColour = $labelObj->textColour; # May be 'undef'
$label3 = Gtk3::Label->new();
$table->attach($label3, 0, 0, 3, 1);
$label3->set_markup('Text colour');
$label3->set_alignment(0, 0.5);
($frame, $canvas, $canvasObj) = $self->addSimpleCanvas($table,
$textColour,
undef, # No neutral colour
3, 6, 0, 1,
);
$button = Gtk3::Button->new('Set');
$table->attach($button, 6, 0, 3, 1);
$button->signal_connect('clicked' => sub {
my $choice = $self->showColourSelectionDialogue(
'Text colour',
$labelObj->textColour,
);
if ($choice) {
$textColour = $choice;
$canvasObj = $self->fillSimpleCanvas($canvas, $canvasObj, $choice);
}
});
$button2 = Gtk3::Button->new('Reset');
$table->attach($button2, 9, 0, 3, 1);
$button2->signal_connect('clicked' => sub {
$textColour = undef;
$canvasObj = $self->fillSimpleCanvas($canvas, $canvasObj);
});
# Underlay colour
$underlayColour = $labelObj->underlayColour; # May be 'undef'
$label4 = Gtk3::Label->new();
$table->attach($label4, 0, 1, 3, 1);
$label4->set_markup('Underlay colour');
$label4->set_alignment(0, 0.5);
($frame2, $canvas2, $canvasObj2) = $self->addSimpleCanvas($table,
$underlayColour,
undef, # No neutral colour
3, 6, 1, 2,
);
$button3 = Gtk3::Button->new('Set');
$table->attach($button3, 6, 1, 3, 1);
$button3->signal_connect('clicked' => sub {
my $choice = $self->showColourSelectionDialogue(
'Underlay colour',
$labelObj->underlayColour,
);
if ($choice) {
$underlayColour = $choice;
$canvasObj2 = $self->fillSimpleCanvas($canvas2, $canvasObj2, $choice);
}
});
$button4 = Gtk3::Button->new('Reset');
$table->attach($button4, 9, 1, 3, 1);
$button4->signal_connect('clicked' => sub {
$underlayColour = undef;
$canvasObj2 = $self->fillSimpleCanvas($canvas2, $canvasObj2);
});
# Relative size
$label5 = Gtk3::Label->new();
$table->attach($label5, 0, 2, 3, 1);
$label5->set_markup('Size (0.5 - 10)');
$label5->set_alignment(0, 0.5);
$entry2 = Gtk3::Entry->new();
$table->attach($entry2, 3, 2, 9, 1);
$entry2->set_text($labelObj->relSize);
$entry2->set_width_chars(8);
$entry2->set_max_length(8);
# Flags
$checkButton = Gtk3::CheckButton->new_with_label('Italics');
$table->attach($checkButton, 0, 3, 3, 1);
$checkButton->set_active($labelObj->italicsFlag);
$checkButton2 = Gtk3::CheckButton->new_with_label('Bold');
$table->attach($checkButton2, 0, 4, 3, 1);
$checkButton2->set_active($labelObj->boldFlag);
$checkButton3 = Gtk3::CheckButton->new_with_label('Underline');
$table->attach($checkButton3, 0, 5, 3, 1);
$checkButton3->set_active($labelObj->underlineFlag);
$checkButton4 = Gtk3::CheckButton->new_with_label('Strike');
$table->attach($checkButton4, 3, 3, 9, 1);
$checkButton4->set_active($labelObj->strikeFlag);
$checkButton5 = Gtk3::CheckButton->new_with_label('Draw box');
$table->attach($checkButton5, 3, 4, 9, 1);
$checkButton5->set_active($labelObj->boxFlag);
# Orientation
$count = -1;
@list = (
0 => 'Normal orientation',
180 => 'Rotated 180 degrees',
90 => 'Rotated 90 degrees clockwise',
270 => 'Rotated 90 degrees anti-clockwise',
-1 => 'Custom orientation (set below)',
);
do {
my $angle = shift @list;
my $descrip = shift @list;
push (@comboList, $descrip);
$descripHash{$descrip} = $angle;
$revDescripHash{$angle} = $descrip;
$count++;
if ($angle == $labelObj->rotateAngle) {
$index = $count;
$angleFlag = TRUE;
}
} until (! @list);
$combo2 = Gtk3::ComboBoxText->new();
$table->attach($combo2, 0, 6, 12, 1);
foreach my $item (@comboList) {
$combo2->append_text($item);
}
# ->signal_connect appears below
$label6 = Gtk3::Label->new();
$table->attach($label6, 0, 7, 3, 1);
$label6->set_markup('Degrees (0-359)');
$label6->set_alignment(0, 0.5);
$entry3 = Gtk3::Entry->new();
$table->attach($entry3, 3, 7, 9, 1);
$entry3->set_text($labelObj->rotateAngle);
$entry3->set_width_chars(3);
$entry3->set_max_length(3);
if ($angleFlag) {
$combo2->set_active($index);
$entry3->set_sensitive(FALSE);
} else {
$combo2->set_active($count);
$entry3->set_sensitive(TRUE);
}
# ->signal_connect from above
$combo2->signal_connect('changed' => sub {
my $descrip = $combo2->get_active_text();
if ($descrip eq $revDescripHash{-1}) {
$entry3->set_sensitive(TRUE);
$entry3->set_text(0);
} else {
$entry3->set_sensitive(FALSE);
$entry3->set_text($descripHash{$descrip});
}
});
}
# Display the dialogue window. The double call to ->present is needed so the user can type
# into the entry/textview right away
$vBox->show_all();
$dialogueWin->present();
$dialogueWin->present();
# If the user clicked 'cancel', $response will be 'reject'
$response = $dialogueWin->run();
if (defined $text) {
# User pressed their ENTER key in the Gtk3::Entry, so $text is already set
$response = 'accept';
} elsif ($entry) {
$text = $entry->get_text();
} else {
$text = $axmud::CLIENT->desktopObj->bufferGetText($buffer);
}
if ($response ne 'accept') {
$dialogueWin->destroy();
$self->restoreFocus();
return @emptyList;
# Otherwise, user clicked 'ok'
} elsif (! $customiseFlag) {
$choice = $combo->get_active_text();
$dialogueWin->destroy();
$self->restoreFocus();
return ($text, $choice);
} else {
# Update the map label object's IVs
$labelObj->ivPoke('textColour', $textColour);
$labelObj->ivPoke('underlayColour', $underlayColour);
$relSize = $entry2->get_text();
if (defined $relSize && $axmud::CLIENT->floatCheck($relSize, 0.5, 10)) {
$labelObj->ivPoke('relSize', $relSize);
}
if (! $checkButton->get_active()) {
$labelObj->ivPoke('italicsFlag', FALSE);
} else {
$labelObj->ivPoke('italicsFlag', TRUE);
}
if (! $checkButton2->get_active()) {
$labelObj->ivPoke('boldFlag', FALSE);
} else {
$labelObj->ivPoke('boldFlag', TRUE);
}
if (! $checkButton3->get_active()) {
$labelObj->ivPoke('underlineFlag', FALSE);
} else {
$labelObj->ivPoke('underlineFlag', TRUE);
}
if (! $checkButton4->get_active()) {
$labelObj->ivPoke('strikeFlag', FALSE);
} else {
$labelObj->ivPoke('strikeFlag', TRUE);
}
if (! $checkButton5->get_active()) {
$labelObj->ivPoke('boxFlag', FALSE);
} else {
$labelObj->ivPoke('boxFlag', TRUE);
}
if ($axmud::CLIENT->intCheck($entry3->get_text(), 0, 359)) {
$labelObj->ivPoke('rotateAngle', $entry3->get_text());
} else {
$labelObj->ivPoke('rotateAngle', 0);
}
# The following function call takes care of the ->name IV, and redraws the label in
# every automapper window
$self->worldModelObj->updateLabel(
TRUE, # Update automapper windows now
$self->session,
$labelObj,
$text,
undef, # No style - map label uses its own IVs
);
# Operation complete
$dialogueWin->destroy();
$self->restoreFocus();
return ($labelObj->name, $labelObj->style);
}
}
# Canvas object functions
sub connectExitToRoom {
# Called by $self->canvasObjEventHandler and ->stopDrag
# After the user chooses the 'connect to click' menu item and clicks on a room, connects the
# selected exit to the clicked room, marking it as a broken or region exit if necessary
# Alternatively, after the user drags an exit over a room, connects the exit to the room
# In both cases, also prompts the user to ask if they'd like to create an exit in the
# reverse direction
#
# Expected arguments
# $roomObj - The clicked room (in a different region to the current one)
# $type - What type of exit to create - set to 'broken' or 'region'. If set to
# 'broken', the function checks that it really is a broken exit (and
# cancels the flag, if not)
#
# Optional arguments
# $exitObj - When called by $self->stopDrag, the dragged exit to connect
#
# Return values
# 'undef' on improper arguments or if the exit can't be connected
# 1 otherwise
my ($self, $roomObj, $type, $exitObj, $check) = @_;
# Local variables
my $parentRoomObj;
# Check for improper arguments
if (
! defined $roomObj || ! defined $type || ($type ne 'broken' && $type ne 'region')
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->connectExitToRoom', @_);
}
# If an exit wasn't specified, use the selected exit
if (! $exitObj) {
$exitObj = $self->selectedExit;
}
# There are restrictions on wilderness rooms; check whether they apply
$parentRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->parent);
if ($roomObj->wildMode eq 'wild' || $parentRoomObj->wildMode eq 'wild') {
$self->showMsgDialogue(
'Connect exit',
'error',
'Exits cannot be connected to a \'wilderness\' room',
'ok',
);
return undef;
} elsif ($parentRoomObj->wildMode eq 'wild') {
# This should not be possible, but just in case, refuse anyway
$self->showMsgDialogue(
'Connect exit',
'error',
'Exits from a \'wilderness\' room cannot be connected to any other room',
'ok',
);
return undef;
} elsif ($roomObj->wildMode eq 'border' && $parentRoomObj->wildMode eq 'border') {
$self->showMsgDialogue(
'Connect exit',
'error',
'Exits in \'wilderness border\' rooms can only be connected to \'normal\' rooms',
'ok',
);
return undef;
}
# Special case: if the exit is a 'retracing' exit - it leads back to the same room - then
# it's obviously not a region or broken exit
if ($parentRoomObj && $parentRoomObj eq $roomObj) {
# The callback can take care of everything
return $self->markRetracingExitCallback();
}
# Otherwise, connect the selected exit to the clicked room and instruct the world model to
# update its Automapper windows
$self->worldModelObj->connectRegionBrokenExit(
$self->session,
TRUE, # Update Automapper windows now
$roomObj,
$exitObj,
$type,
);
# If the selected exit is an unallocated/unallocatable exit, or if it's an up/down exit (and
# assuming that it's not a region exit), nothing will appear to have happened. In this
# case, display a short confirmation message
if (
# If it's a region exit, the region will have changed
! $exitObj->regionFlag
&& (
$exitObj->drawMode eq 'temp_alloc'
|| $exitObj->drawMode eq 'temp_unalloc'
|| $exitObj->mapDir eq 'up'
|| $exitObj->mapDir eq 'down'
)
) {
$self->showMsgDialogue(
'Connect exit',
'info',
'Exit #' . $exitObj->number . ' now leads to room #' . $roomObj->number,
'ok',
);
}
return 1;
}
sub setColouredSquare {
# Called by $self->canvasEventHandler
# Sets up a coloured block at the position on the background map that the user has just
# clicked
#
# Expected arguments
# $xBlocks, $yBlocks
# - The coordinates of the gridblock that was just clicked
#
# Return values
# 'undef' on improper arguments or or if the user declines to proceed, after prompting
# 1 otherwise
my ($self, $xBlocks, $yBlocks, $check) = @_;
# Local variables
my (
$level, $string, $choice,
@squareList, @rectList,
);
# Check for improper arguments
if (! defined $xBlocks || ! defined $yBlocks || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setColouredSquare', @_);
}
# Set the square to be drawn on all levels, or just the current level
if (! $self->bgAllLevelFlag) {
# Just the current level
$level = $self->currentRegionmap->currentLevel;
}
# Get a list of coloured blocks occupying the same block (might be more than one, if
# there are blocks on different levels)
@squareList = $self->currentRegionmap->fetchSquareInSquare(
$xBlocks,
$yBlocks,
$level,
);
# Get a list of coloured rectangles occupying a portion of the area (might be more than
# one, if there are rectangles on different levels)
@rectList = $self->currentRegionmap->fetchRectInSquare(
$xBlocks,
$yBlocks,
$level,
);
# If there is more than one square, of if there are any rectangles, prompt the user
# before erasing them
if (@squareList > 1 || @rectList) {
if ($self->bgColourChoice) {
$string = "Are you sure you want to overwrite this block? It contains:\n";
} else {
$string = "Are you sure you want to erase this block? It is occupied by:\n";
}
$choice = $self->showMsgDialogue(
'Colour background',
'question',
$string . "Coloured squares: " . (scalar @squareList) . "\nColoured rectangles: "
. (scalar @rectList),
'yes-no',
undef,
TRUE, # Preserve newline characters in the message
);
if (! defined $choice || $choice ne 'yes') {
return undef;
}
}
# Erase any existing coloured blocks/squares
foreach my $coord (@squareList) {
# $coord can be in the form 'x_y_z' or 'x_y'; in either case, we don't want the z
my ($x, $y) = split (/_/, $coord);
$self->currentRegionmap->removeSquare($coord);
$self->deleteCanvasObj(
'square',
$x . '_' . $y,
$self->currentRegionmap,
$self->currentParchment,
);
}
foreach my $obj (@rectList) {
$self->currentRegionmap->removeRect($obj);
$self->deleteCanvasObj(
'rect',
$obj->number,
$self->currentRegionmap,
$self->currentParchment,
);
}
if ($self->bgColourChoice) {
# Colour in a new block
if (
$self->currentRegionmap->storeSquare(
$self->bgColourChoice,
$xBlocks,
$yBlocks,
$level,
)
) {
# Draw the coloured block
$self->drawColouredSquare(
$self->currentRegionmap,
$self->bgColourChoice,
$xBlocks,
$yBlocks,
$level,
$self->currentParchment,
);
}
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
sub setColouredRect {
# Called by $self->canvasEventHandler
# Sets up a coloured rectangle at the position on the background map that the user has just
# clicked
#
# Expected arguments
# $xBlocks, $yBlocks
# - The coordinates of the gridblock that was just clicked
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $xBlocks, $yBlocks, $check) = @_;
# Local variables
my (
$level, $colourObj, $choice,
@squareList, @rectList,
);
# Check for improper arguments
if (! defined $xBlocks || ! defined $yBlocks || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setColouredRect', @_);
}
# Set the square to be drawn on all levels, or just the current level
if (! $self->bgAllLevelFlag) {
# Just the current level
$level = $self->currentRegionmap->currentLevel;
}
if ($self->bgColourChoice) {
# Update the regionmap's IVs
$colourObj = $self->currentRegionmap->storeRect(
$self->session,
$self->bgColourChoice,
$self->bgRectXPos,
$self->bgRectYPos,
$xBlocks,
$yBlocks,
$level,
);
if (! $colourObj) {
# Show a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Colour background',
'error',
'Can\'t draw a coloured rectangle over one or more coloured squares (but'
. ' rectangles can be drawn over other rectangles)',
'ok',
);
} else {
# Draw the coloured rectangle. If any other rectangle(s) already exist in the same
# space, this rectangle is drawn on top of them
$self->drawColouredRect(
$self->currentRegionmap,
$colourObj,
$self->currentRegionmap->currentLevel,
$self->currentParchment,
);
}
} else {
# When $self->bgColourChoice is not defined, instead of drawing a coloured rectangle,
# we remove any coloured blocks/rectangles occupying that rectangular area
# Get a list of coloured blocks in the area
@squareList = $self->currentRegionmap->fetchSquareInArea(
$self->bgRectXPos,
$self->bgRectYPos,
$xBlocks,
$yBlocks,
$level,
);
# Get a list of coloured rectangles occupying a portion of the area
@rectList = $self->currentRegionmap->fetchRectInArea(
$self->bgRectXPos,
$self->bgRectYPos,
$xBlocks,
$yBlocks,
$level,
);
# If there is more than one square, of if there are any rectangles, prompt the user
# before continuing
if (@squareList > 1 || @rectList) {
$choice = $self->showMsgDialogue(
'Colour background',
'question',
"Are you sure you want to erase this area? It contains:\n"
. "Coloured squares: " . (scalar @squareList) . "\n"
. "Coloured rectangles: " . (scalar @rectList),
'yes-no',
undef,
TRUE, # Preserve newline characters in the message
);
if (defined $choice && $choice eq 'yes') {
foreach my $coord (@squareList) {
# $coord can be in the form 'x_y_z' or 'x_y'; in either case, we don't
# want the z
my ($x, $y) = split (/_/, $coord);
$self->currentRegionmap->removeSquare($coord);
$self->deleteCanvasObj(
'square',
$x . '_' . $y,
$self->currentRegionmap,
$self->currentParchment,
);
}
foreach my $obj (@rectList) {
$self->currentRegionmap->removeRect($obj);
$self->deleteCanvasObj(
'rect',
$obj->number,
$self->currentRegionmap,
$self->currentParchment,
);
}
}
}
}
# Reset IVs
$self->ivPoke('bgColourMode', 'rect_start');
$self->ivUndef('bgRectXPos');
$self->ivUndef('bgRectYPos');
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$self->restrictWidgets();
return 1;
}
# Room movement functions
sub moveRoomsInDir {
# Called by $self->moveSelectedRoomsLabelsCallback
# Moves the selected rooms (together with their room tags, room guilds, exits and exit tags)
# and any selected labels in a specified direction
# NB This function won't move labels on their own - selected labels are only moved alongside
# selected rooms
#
# Expected arguments
# $distance - The distance to move (in gridblocks)
# $dir - The direction in which to move (a standard primary direction)
#
# Return values
# 'undef' on improper arguments, if there is no current regionmap, if there are no
# selected rooms, if the selected rooms/labels aren't all in the same regionmap, or if
# there is a general error
# 1 otherwise
my ($self, $distance, $dir, $check) = @_;
# Local variables
my ($adjustXPos, $adjustYPos, $adjustZPos);
# Check for improper arguments
if (! defined $distance || ! defined $dir || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->moveRoomsInDir', @_);
}
# Don't do anything if there isn't a current regionmap, or if there are no selected rooms
if (
! $self->currentRegionmap
|| (! $self->selectedRoom && ! $self->selectedRoomHash)
) {
return undef;
}
# Check that the selected rooms/labels are all in the same region. We ignore selected room
# tags, room guilds, exits and exit tags for the moment
if (! $self->checkSelectedInSameRegion()) {
# Show a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The selected rooms/labels can\'t be moved because they are not all in the same'
. ' region',
'ok',
);
return undef;
}
# Work out by how many blocks along each axis the rooms' coordinates need to be changed
($adjustXPos, $adjustYPos, $adjustZPos) = $self->interpretDir($distance, $dir);
if (! defined $adjustXPos) {
$self->showMsgDialogue(
'Move selected rooms',
'error',
'General error moving selected rooms/labels',
'ok',
);
return undef;
}
# Now check every selected room at the equivalent coordinates, checking that its proposed
# position isn't outside the boundaries of the map and isn't already occupied by another
# room
# Also check the proposed position of any selected labels, which must not be outside the
# boundaries of the map
if (
! $self->checkNewCoordinates($adjustXPos, $adjustYPos, $adjustZPos)
|| ! $self->checkNewLabelPositions($adjustXPos, $adjustYPos, $adjustZPos)
) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The selected rooms/labels can\'t be moved to this position, either because the'
. ' space is already occupied, or because at least one of them falls outside the'
. ' boundaries of the map',
'ok',
);
return undef;
}
# Move all of the selected rooms/labels to their new position
if (! $self->moveSelectedObjs($adjustXPos, $adjustYPos, $adjustZPos)) {
# This is a serious error, since half the rooms may be copied, and half not, so show an
# error message
return $self->session->writeError(
'General error moving selected rooms/labels',
$self->_objClass . '->moveRoomsInDir',
);
} else {
# Operation complete
return 1;
}
}
sub moveRoomsToClick {
# Called by $self->canvasEventHandler
# Immediately after the user clicks on an empty region of the map, moves the selected rooms
# (together with their room tags, room guilds, exits and exit tags) and any selected
# labels to the clicked area of the map
# NB This function won't move labels on their own - selected labels are only moved alongside
# selected rooms
#
# Expected arguments
# $clickXPosBlocks, $clickYPosBlocks
# - The grid coordinates on the map of the user's mouse click
#
# Return values
# 'undef' on improper arguments, if there is no current regionmap, if there are no
# selected rooms, if the selected rooms/labels aren't all in the same regionmap, or if
# there is a general error
# 1 otherwise
my ($self, $clickXPosBlocks, $clickYPosBlocks, $check) = @_;
# Local variables
my (
$left, $right, $top, $bottom, $up, $down, $roomObj, $newLeft, $newRight, $newTop,
$newBottom, $newUp, $newDown, $adjustXPos, $adjustYPos, $adjustZPos,
);
# Check for improper arguments
if (! defined $clickXPosBlocks || ! defined $clickYPosBlocks || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->moveRoomsToClick', @_);
}
# Don't do anything if there isn't a current regionmap, or if there are no selected rooms
if (
! $self->currentRegionmap
|| (! $self->selectedRoom && ! $self->selectedRoomHash)
) {
return undef;
}
# Check that the selected rooms/labels are all in the same region. We ignore selected exits
# and room tags for the moment
if (! $self->checkSelectedInSameRegion()) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The selected rooms/labels can\'t be moved because they are not all in the same'
. ' region',
'ok',
);
return undef;
}
# Find the boundaries of the area (in three dimensions) covered by the selected rooms
# (ignoring selected exits, room tags and labels for the moment)
($left, $right, $top, $bottom, $up, $down) = $self->findSelectedRoomBoundaries();
if (! defined $left) {
# Error in called function
return undef;
}
# Check that the size of the area isn't physically bigger than the size of the regionmap in
# which the user has clicked
if (
$self->currentRegionmap->gridWidthBlocks < ($right - $left + 1)
|| $self->currentRegionmap->gridHeightBlocks < ($bottom - $top + 1)
) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The selected rooms/labels occupy an area which is too big for the current'
. ' regionmap',
'ok',
);
return undef;
}
# Decide which room among the selected rooms is going to be the 'centre' - the room which is
# moved to the point on the regionmap, on which the user clicked
$roomObj = $self->findMiddleSelectedRoom($left, $right, $top, $bottom, $up, $down);
if (! $roomObj) {
# Error in called function
return undef;
}
# Work out the boundaries of the area covered by the selected rooms once they are moved, if
# we assume that the 'centre' room is moved to the position of the user's click
(
$newLeft, $newRight,
$newTop, $newBottom,
$newUp, $newDown
) = $self->refineSelectedArea(
$left, $right,
$top, $bottom,
$up, $down,
$clickXPosBlocks, $clickYPosBlocks,
$roomObj,
);
if (! defined $newLeft) {
# Error in called function
return undef;
}
# Work out how many blocks along each axis the room's coordinates need to be changed by
$adjustXPos = ($newLeft - $left);
$adjustYPos = ($newTop - $top);
$adjustZPos = ($newDown - $down);
# Check each selected room at its proposed new position, to make sure that it won't occupy a
# position already occupied by another room
# Also check the proposed position of any selected labels, which must not be outside the
# boundaries of the map
if (
! $self->checkSelectedArea($adjustXPos, $adjustYPos, $adjustZPos)
|| ! $self->checkNewLabelPositions($adjustXPos, $adjustYPos, $adjustZPos)
) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The selected rooms/labels can\'t be copied into an area already occupied by other'
. ' rooms',
'ok',
);
return undef;
}
# Move all of the selected rooms/labels to their new position
if (! $self->moveSelectedObjs($adjustXPos, $adjustYPos, $adjustZPos)) {
# This is a serious error, since half the rooms may be copied, and half not, so show an
# error message
return $self->session->writeError(
'General error moving selected rooms/labels',
$self->_objClass . '->moveRoomsToClick',
);
} else {
# Operation complete
return 1;
}
}
sub moveRoomsToExit {
# Called by $self->canvasObjEventHandler
# Immediately after the user clicks on an existing room - and assuming the clicked room has
# an exit which leads to one of the selected rooms - moves all of the selected rooms
# (together with their room tags, room guilds, exits and exit tags) and any selected
# labels to join up with the clicked room
# NB This function won't move labels on their own - selected labels are only moved alongside
# selected rooms
#
# Expected arguments
# $roomObj - The clicked room
#
# Return values
# 'undef' on improper arguments, if there is no current regionmap, if there are no
# selected rooms, if the selected rooms/labels aren't all in the same regionmap, if
# none of the clicked room's exits lead to one of the selected rooms, or if there is a
# general error
# 1 otherwise
my ($self, $roomObj, $check) = @_;
# Local variables
my ($exitObj, $destRoomObj, $xPos, $yPos, $zPos, $adjustXPos, $adjustYPos, $adjustZPos);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->moveRoomsToExit', @_);
}
# Don't do anything if there isn't a current regionmap, or if there are no selected rooms
if (
! $self->currentRegionmap
|| (! $self->selectedRoom && ! $self->selectedRoomHash)
) {
return undef;
}
# Check that the selected rooms/labels are all in the same region. We ignore selected exits
# and room tags for the moment
if (! $self->checkSelectedInSameRegion()) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The selected rooms/labels can\'t be moved because they are not all in the same'
. ' region',
'ok',
);
return undef;
}
# Check that the clicked room has an exit leading to at least one of the selected rooms
$exitObj = $self->checkSelectedIsConnected($roomObj);
if (! $exitObj) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The room on which you clicked doesn\'t have an exit leading to any of the'
. ' selected rooms - try clicking on an empty region of the map, instead',
'ok',
);
return undef;
}
# Get the destination room for $exitObj
$destRoomObj = $self->worldModelObj->ivShow('modelHash', $exitObj->destRoom);
# Work out the destination room's new grid coordinates after the move (e.g. if the exit
# leads 'east', then its x-coord will increase by 1, but its y-coord and z-coord will stay
# the same)
($xPos, $yPos, $zPos) = $self->findNewCoordinates($roomObj, $exitObj);
if (! defined $xPos) {
$self->showMsgDialogue(
'Move selected rooms',
'error',
'General error moving selected rooms/labels',
'ok',
);
return undef;
}
# Work out by how many blocks along each axis the destination room's coordinates (and, by
# extension, the coordinates of every selected room) need to be changed
$adjustXPos = ($xPos - $destRoomObj->xPosBlocks);
$adjustYPos = ($yPos - $destRoomObj->yPosBlocks);
$adjustZPos = ($zPos - $destRoomObj->zPosBlocks);
# Now check every selected room at the equivalent coordinates, making sure that its proposed
# position isn't outside the boundaries of the map and isn't already occupied by another
# room
# Also check the proposed position of any selected labels, which must not be outside the
# boundaries of the map
if (
! $self->checkNewCoordinates($adjustXPos, $adjustYPos, $adjustZPos)
|| ! $self->checkNewLabelPositions($adjustXPos, $adjustYPos, $adjustZPos)
) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Move selected rooms',
'error',
'The selected rooms/labels can\'t be moved to this position, either because'
. ' the space is already occupied, or because at least one of them falls outside'
. ' the boundaries of the map',
'ok',
);
return undef;
}
# Move all of the selected rooms/labels to their new position
if (! $self->moveSelectedObjs($adjustXPos, $adjustYPos, $adjustZPos)) {
# This is a serious error, since half the rooms may be copied, and half not, so show an
# error message
return $self->session->writeError(
'General error moving selected rooms/labels',
$self->_objClass . '->moveRoomsToExit',
);
} else {
# Operation complete
return 1;
}
}
sub transferRoomsToRegion {
# Called by $self->transferSelectedRoomsCallback
# Moves the selected rooms (together with their room tags, room guilds, exits and exit tags)
# and any selected labels to the same position in a different region
# NB This function won't move labels on their own - selected labels are only moved alongside
# selected rooms
#
# Expected arguments
# $regionName - The region into which the rooms/labels must be moved
#
# Return values
# 'undef' on improper arguments, if there is no current regionmap, if there are no
# selected rooms, if the selected rooms/labels aren't all in the same regionmap, or if
# there is a general error
# 1 otherwise
my ($self, $regionName, $check) = @_;
# Local variables
my ($newRegionmap, $failFlag, $left, $right, $top, $bottom, $up, $down, $roomObj);
# Check for improper arguments
if (! defined $regionName || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->transferRoomsToRegion', @_);
}
# Don't do anything if there isn't a current regionmap, or if there are no selected rooms
if (
! $self->currentRegionmap
|| (! $self->selectedRoom && ! $self->selectedRoomHash)
) {
return undef;
}
# Check that the selected rooms/labels are all in the same region. We ignore selected exits
# and room tags for the moment
if (! $self->checkSelectedInSameRegion()) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Transfer selected rooms',
'error',
'The selected rooms/labels can\'t be transferred because they are not all in the'
. ' same region',
'ok',
);
return undef;
}
# Set the destination region as the current one (which means we can reuse existing code)
$self->setCurrentRegion($regionName, TRUE);
# Check each selected room to make sure the same location in the destination regionmap isn't
# already occupied and isn't outside the boundaries of the region
$newRegionmap = $self->worldModelObj->ivShow('regionmapHash', $regionName);
OUTER: foreach my $roomObj ($self->compileSelectedRooms()) {
if (
$newRegionmap->fetchRoom(
$roomObj->xPosBlocks,
$roomObj->yPosBlocks,
$roomObj->zPosBlocks,
)
) {
$failFlag = TRUE;
last OUTER;
}
}
# Also check the proposed position of any selected labels, which must not be outside the
# boundaries of the destination regionmap
if (! $failFlag && ! $self->checkNewLabelPositions(0, 0, 0)) {
$failFlag = TRUE;
}
if ($failFlag) {
# Open a 'dialogue' window to explain the problem
$self->showMsgDialogue(
'Transfer selected rooms',
'error',
'The selected rooms/labels can\'t be transferred, either because the space is'
. ' already occupied, or because at least one of them falls outside the boundaries'
. ' of the map',
'ok',
);
return undef;
}
# Find the boundaries of the area (in three dimensions) covered by the selected rooms
# (ignoring selected exits, room tags and labels for the moment)
($left, $right, $top, $bottom, $up, $down) = $self->findSelectedRoomBoundaries();
if (! defined $left) {
# Error in called function
return $self->session->writeError(
'General error transferring selected rooms/labels',
$self->_objClass . '->transferRoomsToRegion',
);
}
# Find the room nearest to the middle of the selected rooms
$roomObj = $self->findMiddleSelectedRoom($left, $right, $top, $bottom, $up, $down);
# Move all of the selected rooms/labels to their new position. The 0 arguments mean that the
# rooms/labels are moved to the same position in the new regionmap
if (! $self->moveSelectedObjs(0, 0, 0)) {
# This is a serious error, since half the rooms may be copied, and half not, so show an
# error message
return $self->session->writeError(
'General error transferring selected rooms/labels',
$self->_objClass . '->transferRoomsToRegion',
);
}
if ($roomObj) {
# Centre the map over the middle room
$self->centreMapOverRoom($roomObj);
}
# Operation complete
return 1;
}
# Room movement support functions
sub moveSelectedObjs {
# Called by $self->moveRoomsInDir, ->moveRoomsToClick, ->moveRoomsToExit,
# ->transferRoomsToRegion and ->stopDrag
# Moves all selected rooms (along with their room tags, room guilds, exits and exit tags)
# and all selected labels to their new position
#
# Expected arguments
# $adjustXPos, $adjustYPos, $adjustZPos
# - Describes a vector between the coordinates of the selected rooms in their old
# position, and their coordinates in the new position
#
# Return values
# 'undef' on improper arguments or if the move fails
# 1 otherwise
my ($self, $adjustXPos, $adjustYPos, $adjustZPos, $check) = @_;
# Local variables
my (
$roomObj, $oldRegionmapObj,
@list,
%roomHash, %labelHash
);
# Check for improper arguments
if (
! defined $adjustXPos || ! defined $adjustYPos || ! defined $adjustZPos
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->moveSelectedObjs', @_);
}
# Import a list of all the selected rooms, and copy them into a hash
if ($self->selectedRoom) {
$roomHash{$self->selectedRoom->number} = $self->selectedRoom;
} else {
%roomHash = $self->selectedRoomHash;
}
# Also get a list of selected labels, and copy them into a hash
if ($self->selectedLabel) {
$labelHash{$self->selectedLabel->id} = $self->selectedLabel;
} else {
%labelHash = $self->selectedLabelHash;
}
# Using the first room in %roomHash, get the regionmap from which the rooms are moving (may
# be the same as the regionmap to which they are moving, $self->currentRegionmap)
@list = values %roomHash;
$roomObj = $list[0];
$oldRegionmapObj = $self->findRegionmap($roomObj->parent);
# Move the selected rooms/labels
return $self->worldModelObj->moveRoomsLabels(
$self->session,
TRUE, # Update Automapper windows now
$oldRegionmapObj, # Move from this region...
$self->currentRegionmap, # ...to this one...
$adjustXPos, # ...using this vector
$adjustYPos,
$adjustZPos,
\%roomHash,
\%labelHash,
);
}
sub checkSelectedInSameRegion {
# Called by $self->moveRoomsInDir, ->moveRoomsToClick and ->moveRoomsToExit
# Checks that the selected room(s) and label(s) are in the same regionmap (ignores selected
# room tags, room guilds, exits and exit tags)
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if there is an error extracting regions, or if the
# selected room(s) and label(s) aren't all in the same region
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my $firstRegionObj;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->checkSelectedInSameRegion',
@_,
);
}
# If there is just a single selected room or a single selected label, then there is no need
# to check whether things are in different regions
if ($self->selectedRoom || $self->selectedLabel) {
return 1;
}
# Go through every selected room, returning 'undef' for failure if we find any selected
# rooms which aren't in the same regionmap as the first one
foreach my $roomObj ($self->ivValues('selectedRoomHash')) {
my $regionObj = $self->worldModelObj->ivShow('modelHash', $roomObj->parent);
if (! $firstRegionObj) {
# This is the first selected room. Records its region
$firstRegionObj = $regionObj;
} elsif ($regionObj ne $firstRegionObj) {
# The selected rooms are in more than one regionmap
return undef;
}
}
# Do the same for every selected label
foreach my $labelObj ($self->ivValues('selectedLabelHash')) {
my $regionNum = $self->findRegionNum($labelObj->region);
if ($regionNum ne $firstRegionObj->number) {
# This label is in a different regionmap to the selected room(s)
return undef;
}
}
# All the selected rooms and labels are in the same region
return 1;
}
sub checkSelectedIsConnected {
# Called by $self->moveRoomsToExit
# Checks that the clicked room has an exit which leads to at least one of the selected rooms
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room on which the user clicked
#
# Return values
# 'undef' on improper arguments or if none of the clicked room's exits leads to any of the
# selected rooms
# Otherwise, returns the GA::Obj::Exit which connects to one of the selected rooms
my ($self, $roomObj, $check) = @_;
# Local variables
my %roomHash;
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->checkSelectedIsConnected',
@_,
);
}
# Compile a hash of selected rooms
if ($self->selectedRoom) {
$roomHash{$self->selectedRoom->number} = $self->selectedRoom;
} else {
%roomHash = $self->selectedRoomHash;
}
# Check each of the clicked room's exits in turn
foreach my $exitNum ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
if ($exitObj->destRoom && exists $roomHash{$exitObj->destRoom}) {
# Success! The clicked room connects to one of the selected rooms via this exit
return $exitObj;
}
}
# The clicked room doesn't connect to any of the selected rooms
return undef;
}
sub interpretDir {
# Called by $self->moveRoomsInDir
# Convert a distance (in gridblocks) and a standard primary direction into a vector in the
# form (x, y, z)
#
# Expected arguments
# $distance - A distance in gridblocks
# $dir - A standard primary direction, e.g. north
#
# Return values
# An empty list on improper arguments
# Otherwise a list in the form
# ($adjustXPos, $adjustYPos, $adjustZPos);
my ($self, $distance, $dir, $check) = @_;
# Local variables
my (
$adjustXPos, $adjustYPos, $adjustZPos, $listRef,
@emptyList,
);
# Check for improper arguments
if (! defined $distance || ! defined $dir || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->interpretDir', @_);
return @emptyList;
}
# Extract from $self->constVectorHash the list corresponding to the primary direction
# (e.g. $dir = 'north', $listRef = [0, -1, 0] )
$listRef = $self->ivShow('constVectorHash', $dir);
# Work out the vector
$adjustXPos = $$listRef[0] * $distance;
$adjustYPos = $$listRef[1] * $distance;
$adjustZPos = $$listRef[2] * $distance;
return ($adjustXPos, $adjustYPos, $adjustZPos);
}
sub findSelectedRoomBoundaries {
# Called by $self->moveRoomsToClick
# Finds the boundaries of the area (in three dimensions) covered by the selected rooms
# Ignores selected room tags, room guilds, exits, exit tags and labels
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments
# Otherwise a list of map coordinates, representing the boundaries of the smallest
# three-dimensional area containing all the selected rooms, in the form
# ($left, $right, $top, $bottom, $up, $down)
my ($self, $check) = @_;
# Local variables
my (
$left, $right, $top, $bottom, $up, $down,
@emptyList,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findSelectedRoomBoundaries', @_);
return @emptyList;
}
# If there is a single selected room, the job is easy
if ($self->selectedRoom) {
return (
$self->selectedRoom->xPosBlocks, # $left
$self->selectedRoom->xPosBlocks, # $right
$self->selectedRoom->yPosBlocks, # $top
$self->selectedRoom->yPosBlocks, # $bottom
$self->selectedRoom->zPosBlocks, # $up
$self->selectedRoom->zPosBlocks, # $down
);
} else {
# Otherwise, go through each selected room in turn
foreach my $roomObj ($self->ivValues('selectedRoomHash')) {
if (! defined $left) {
# This is the first room in the list
$left = $roomObj->xPosBlocks;
$right = $roomObj->xPosBlocks;
$top = $roomObj->yPosBlocks;
$bottom = $roomObj->yPosBlocks;
$up = $roomObj->zPosBlocks;
$down = $roomObj->zPosBlocks;
} else {
if ($roomObj->xPosBlocks < $left) {
$left = $roomObj->xPosBlocks;
}
if ($roomObj->xPosBlocks > $right) {
$right = $roomObj->xPosBlocks;
}
if ($roomObj->yPosBlocks < $top) {
$top = $roomObj->yPosBlocks;
}
if ($roomObj->yPosBlocks > $bottom) {
$bottom = $roomObj->yPosBlocks;
}
if ($roomObj->zPosBlocks < $down) {
$down = $roomObj->zPosBlocks;
}
if ($roomObj->zPosBlocks > $up) {
$up = $roomObj->zPosBlocks;
}
}
}
# Operation complete
return ($left, $right, $top, $bottom, $up, $down);
}
}
sub findNewCoordinates {
# Called by $self->moveRoomsToExit
# Given the clicked room and one of its exits, find the coordinates where we would normally
# expect to find the destination room
#
# Expected arguments
# $roomObj - The GA::ModelObj::Room on which the user clicked
# $exitObj - Its GA::Obj::Exit which leads to one of the selected rooms
#
# Return values
# An empty list on improper arguments or for a general error
# Otherwise returns a list of map coordinates in the form (xPos, $yPos, $zPos)
my ($self, $roomObj, $exitObj, $check) = @_;
# Local variables
my (
$standardDir, $xPos, $yPos, $zPos, $exitLength, $listRef,
@emptyList,
%vectorHash,
);
# Check for improper arguments
if (! defined $roomObj || ! defined $exitObj || defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findNewCoordinates', @_);
return @emptyList;
}
# For unallocatable exits, there are no expected coordinates
if (! $exitObj->mapDir) {
return @emptyList;
}
# Extract from $self->constVectorHash the list corresponding to the exit's map direction
# (e.g. $exitObj->mapDir = 'north', $listRef = [0, -1, 0] )
$listRef = $self->ivShow('constVectorHash', $exitObj->mapDir);
# Work out the coordinates of $exitObj's destination room after the move
$exitLength = $self->worldModelObj->getExitLength($exitObj);
$xPos = $roomObj->xPosBlocks + ($$listRef[0] * $exitLength);
$yPos = $roomObj->yPosBlocks + ($$listRef[1] * $exitLength);
$zPos = $roomObj->zPosBlocks + ($$listRef[2] * $exitLength);
return ($xPos, $yPos, $zPos);
}
sub checkNewCoordinates {
# Called by $self->moveRoomsInDir and ->moveRoomsToExit
# Given the direction that all the selected rooms need to be moved - described by a vector
# (x, y, z) - check that the proposed positions of each selected rooms is not already
# occupied by another room and is not outside the boundaries of the map
#
# Expected arguments
# $adjustXPos, $adjustYPos, $adjustZPos
# - The vector that describes the direction in which all selected rooms must be moved
#
# Return values
# 'undef' on improper arguments, or if any of the proposed positions are occupied by other
# rooms or are outside the boundaries of the map
# 1 otherwise
my ($self, $adjustXPos, $adjustYPos, $adjustZPos, $check) = @_;
# Local variables
my (
@roomList,
%roomHash,
);
# Check for improper arguments
if (
! defined $adjustXPos || ! defined $adjustYPos || ! defined $adjustZPos
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->checkNewCoordinates', @_);
}
# Compile a hash of selected rooms
if ($self->selectedRoom) {
$roomHash{$self->selectedRoom->number} = $self->selectedRoom;
} else {
%roomHash = $self->selectedRoomHash;
}
# Also use a list of selected rooms
@roomList = values %roomHash;
foreach my $roomObj (@roomList) {
my ($xPos, $yPos, $zPos, $posn);
# Get the proposed position of the room
$xPos = $roomObj->xPosBlocks + $adjustXPos;
$yPos = $roomObj->yPosBlocks + $adjustYPos;
$zPos = $roomObj->zPosBlocks + $adjustZPos;
# Check that the gridblock isn't outside the boundaries of the map
if (
(($xPos < 0) || ($xPos >= $self->currentRegionmap->gridWidthBlocks))
|| (($yPos < 0) || ($yPos >= $self->currentRegionmap->gridHeightBlocks))
) {
# The proposed position is outside the map's boundary
return undef;
}
# Check that the gridblock isn't already occupied by another room that's not one of the
# selected rooms (which is also being moved)
$posn = $xPos . '_' . $yPos . '_' . $zPos;
if (
$self->currentRegionmap->ivExists('gridRoomHash', $posn)
&& (! exists $roomHash{$self->currentRegionmap->ivShow('gridRoomHash', $posn)})
) {
# The gridblock is occupied
return undef;
}
}
# All of the selected rooms can be moved to their new positions
return 1;
}
sub findMiddleSelectedRoom {
# Called by $self->moveRoomsToClick
# Using the selected rooms which cover a three-dimensional area described by the supplied
# arguments, find the room which is closest to the middle, and return it
# However, if the automapper's current room is a selected room, return that instead
#
# Expected arguments
# $left, $right, $top, $bottom, $up, $down
# - The boundaries of the three-dimensional area containing the selected rooms
#
# Return values
# 'undef' on improper arguments
# Otherwise returns the blessed reference of the GA::ModelObj::Room closest to the centre
# of the area (or the blessed reference of the current room, if it is a selected room)
my ($self, $left, $right, $top, $bottom, $up, $down, $check) = @_;
# Local variables
my ($xPos, $yPos, $zPos, $nearestRoomObj, $nearestLength);
# Check for improper arguments
if (
! defined $left || ! defined $right || ! defined $top || ! defined $bottom
|| ! defined $up || ! defined $down || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->findMiddleSelectedRoom', @_);
}
# If there is only a single selected room, then that's the one in the middle
if ($self->selectedRoom) {
return $self->selectedRoom;
# If the automapper's current room is selected, then that's the one in the middle
# (regardless of its position)
} elsif (
$self->mapObj->currentRoom
&& $self->ivExists('selectedRoomHash', $self->mapObj->currentRoom->number)
) {
return $self->mapObj->currentRoom;
} else {
# Find the middle of the three-dimensional area
$xPos = $left + (($right - $left) / 2);
$yPos = $top + (($bottom - $top) / 2);
$zPos = $down + (($up - $down) / 2);
foreach my $roomObj ($self->ivValues('selectedRoomHash')) {
my $length;
if (! $nearestRoomObj) {
# This is the first room in the list
$nearestRoomObj = $roomObj;
# Find its distance from the middle using Euclydian geometry...
$nearestLength = sqrt (
(($xPos - $roomObj->xPosBlocks) ** 2)
+ (($yPos - $roomObj->yPosBlocks) ** 2)
+ (($zPos - $roomObj->zPosBlocks) ** 2)
);
} else {
$length = sqrt(
(($xPos - $roomObj->xPosBlocks) ** 2)
+ (($yPos - $roomObj->yPosBlocks) ** 2)
+ (($zPos - $roomObj->zPosBlocks) ** 2)
);
if ($length < $nearestLength) {
# This room is nearer to the middle
$nearestRoomObj = $roomObj;
$nearestLength = $length;
}
}
}
return $nearestRoomObj;
}
}
sub refineSelectedArea {
# Called by $self->moveRoomsToClick
# Given the boundaries of the three-dimensional area covered by the selected rooms, and
# given the blessed reference of the room which is to be moved to the position on the map
# where the user clicked, return the boundaries of the new area
# At the same time, if those boundaries would mean selected rooms being outside the physical
# limits of the map, adjust the boundaries so that all the rooms are on the map (which
# will mean that the 'centre' room is no longer placed at the position where the user
# clicked)
#
# Expected arguments
# $left, $right, $top, $bottom, $up, $down
# - The boundaries of the three-dimensional area containing the selected rooms
# $clickXPosBlocks, $clickYPosBlocks
# - The grid coordinates on the map of the user's click
# $roomObj
# - The RoomModelObj of the 'centre' room
#
# Return values
# An empty list on improper arguments
# Otherwise returns the boundaries of the refined area, in the form
# ($newLeft, $newRight, $newTop, $newBottom, $newUp, $newDown)
my (
$self, $left, $right, $top, $bottom, $up, $down, $clickXPosBlocks, $clickYPosBlocks,
$roomObj, $check
) = @_;
# Local variables
my (
$xLength, $yLength, $zLength, $newLeft, $newRight, $newTop, $newBottom, $newUp,
$newDown,
);
# Check for improper arguments
if (
! defined $left || ! defined $right || ! defined $top || ! defined $bottom
|| ! defined $up || ! defined $down || ! defined $roomObj
|| ! defined $clickXPosBlocks || ! defined $clickYPosBlocks || defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->refineSelectedArea', @_);
}
# First, work out the grid coordinates of the 'centre' room, relative to the top-left corner
# of the area containing all the selected rooms
$xLength = $roomObj->xPosBlocks - $left;
$yLength = $roomObj->yPosBlocks - $top;
$zLength = $roomObj->zPosBlocks - $down;
# Next, find the top-left corner of the area that will contain all the selected rooms when
# they are moved, with the 'centre' room over the gridblock clicked by the user
$newLeft = $clickXPosBlocks - $xLength;
$newTop = $clickYPosBlocks - $yLength;
$newDown = $self->currentRegionmap->currentLevel - $zLength;
# Find also the bottom-right corner
$newRight = $newLeft + ($right - $left);
$newBottom = $newTop + ($bottom - $top);
$newUp = $newDown + ($up - $down);
# Now we need to check whether all the rooms will still fit on the map, if we were to move
# the selected rooms to the new area (with $roomObj moved to the position of the click)
# If not, we need to change the clicked gridblock until the rooms do fit
if ($newLeft < 0) {
$newLeft = 0;
$newRight = ($right - $left);
} elsif ($newRight >= $self->currentRegionmap->gridWidthBlocks) {
$newLeft = $self->currentRegionmap->gridWidthBlocks - ($right - $left - 1);
$newRight = $self->currentRegionmap->gridWidthBlocks - 1;
}
if ($newTop < 0) {
$newTop = 0;
$newBottom = ($bottom - $top);
} elsif ($newBottom >= $self->currentRegionmap->gridHeightBlocks) {
$newTop = $self->currentRegionmap->gridHeightBlocks - ($bottom - $top - 1);
$newBottom = $self->currentRegionmap->gridHeightBlocks - 1;
}
# Operation complete
return ($newLeft, $newRight, $newTop, $newBottom, $newUp, $newDown);
}
sub checkSelectedArea {
# Called by $self->moveRoomsToClick
# Checks the gridblocks into which the selected rooms will be copied, looking for any blocks
# which are already occupied by other rooms
#
# Expected arguments
# $adjustXPos, $adjustYPos, $adjustZPos
# - Describes a vector between the coordinates of the selected rooms in their
# old position, and their coordinates at their new position
#
# Return values
# 'undef' on improper arguments, or if any of the selected rooms is about to be copied
# into an occupied gridblock
# 1 otherwise
my ($self, $adjustXPos, $adjustYPos, $adjustZPos, $check) = @_;
# Local variables
my %roomHash;
# Check for improper arguments
if (
! defined $adjustXPos || ! defined $adjustYPos || ! defined $adjustZPos
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->checkSelectedArea', @_);
}
# Import a list of all the selected rooms, and copy them into a hash
if ($self->selectedRoom) {
$roomHash{$self->selectedRoom->number} = $self->selectedRoom;
} else {
%roomHash = $self->selectedRoomHash;
}
# Check each one in turn
foreach my $roomObj (values %roomHash) {
my ($xPos, $yPos, $zPos, $posn);
# Get the room's proposed coordinates
$xPos = $roomObj->xPosBlocks + $adjustXPos;
$yPos = $roomObj->yPosBlocks + $adjustYPos;
$zPos = $roomObj->zPosBlocks + $adjustZPos;
# The current regionmap stores rooms in a hash, in the form
# ->gridRoomHash{'x_y_z'} = model_number_of_room_at_these_coordinates
# Create the key that would correspond to this room
$posn = $xPos . '_' . $yPos . '_' . $zPos;
# Is that gridblock occupied (i.e. does the key exist in the hash?)
if ($self->currentRegionmap->ivExists('gridRoomHash', $posn)) {
# The gridblock is occupied; but is the occupying room one of the selected rooms
# that is about to be moved anyway?
if (! exists $roomHash{$self->currentRegionmap->ivShow('gridRoomHash', $posn)}) {
# This gridblock is occupied by a room that's not going to be moved.
return undef;
}
}
}
# Operation complete. All the necessary gridblocks are empty.
return 1;
}
sub checkNewLabelPositions {
# Called by $self->moveRoomsInDir, ->moveRoomsToClick and ->moveRoomsToExit
# Checks that the new positions of any selected labels (if any) are within the boundaries of
# the map
#
# Expected arguments
# $adjustXPos, $adjustYPos, $adjustZPos
# - Describes a vector between the coordinates of the selected rooms in their old
# position, and their coordinates in the new position (in gridblocks)
#
# Return values
# 'undef' on improper arguments or if any of the selected labels will be moved outside the
# boundaries of the map
# 1 otherwise
my ($self, $adjustXPos, $adjustYPos, $adjustZPos, $check) = @_;
# Local variables
my (
$mapWidthPixels, $mapHeightPixels,
%labelHash,
);
# Check for improper arguments
if (
! defined $adjustXPos || ! defined $adjustYPos || ! defined $adjustZPos
|| defined $check
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->checkNewLabelPositions', @_);
}
# Get a list of selected labels, and copy them into a hash
if ($self->selectedLabel) {
$labelHash{$self->selectedLabel->id} = $self->selectedLabel;
} else {
%labelHash = $self->selectedLabelHash;
}
# Work out the current size of the map, in pixels
$mapWidthPixels = (
$self->currentRegionmap->blockWidthPixels
* $self->currentRegionmap->gridWidthBlocks
);
$mapHeightPixels = (
$self->currentRegionmap->blockHeightPixels
* $self->currentRegionmap->gridHeightBlocks
);
# Check each label in turn
foreach my $labelObj (values %labelHash) {
my ($xPosPixels, $yPosPixels, $level);
# Work out the x/y coordinates, in pixels, of the label after it is moved
$xPosPixels = $labelObj->xPosPixels
+ ($adjustXPos * $self->currentRegionmap->blockWidthPixels);
$yPosPixels = $labelObj->yPosPixels
+ ($adjustYPos * $self->currentRegionmap->blockHeightPixels);
# Work out the label's new level
$level = $labelObj->level + $adjustZPos;
# Check the label's position
if (
($xPosPixels < 0)
|| ($xPosPixels >= ($mapWidthPixels - 1))
|| ($yPosPixels < 0)
|| ($yPosPixels >= ($mapHeightPixels - 1))
) {
# The label is outside the boundaries of the map
return undef;
}
}
# All labels (if there are any) are within the boundaries of the map
return 1;
}
# Other functions
sub trackPosn {
# Called by GA::Obj::Map->setCurrentRoom
# Examines the current room's position in the visible map and, if the room is too close to
# the edge of the visible map, moves the window's scrollbars to centre the visible map
# over the current room
# Does nothing if the world model's tracking flag isn't set
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments, if the tracking flag isn't set or if there is no current
# room
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$roomObj, $sensitivity, $centreFlag, $startXBlocks, $startYBlocks, $widthBlocks,
$heightBlocks, $centreXBlocks, $centreYBlocks, $insideStartXBlocks, $insideStartYBlocks,
$insideStopXBlocks, $insideStopYBlocks, $scrollXPos, $scrollYPos,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->trackPosn', @_);
}
# Import the current room
$roomObj = $self->mapObj->currentRoom;
# Don't do anything if there is no current room, or if the tracking flag isn't set
if (! $roomObj || ! $self->worldModelObj->trackPosnFlag) {
return undef;
}
# Import the tracking sensitivity, a value from 0-1
# 0 means 'always centre the map on the current room', 1 means 'centre the map only when the
# current room is outside the visible window'
# 0.5 means that the room must be halfway between the centre of the visible map, before the
# map is centred. 0.66 means the room must be two-thirds of the distance away from the
# centre, and 0.9 means that the room must be 90% of the distance away from the centre
$sensitivity = $self->worldModelObj->trackingSensitivity;
# Deal with special case of sensitivity = 0
if (! $sensitivity) {
# Don't bother checking the current room's position in the visible map - go ahead and
# centre it
$centreFlag = TRUE;
} else {
# Get the size and position of the visible map
($startXBlocks, $startYBlocks, $widthBlocks, $heightBlocks)
= $self->getMapPosnInBlocks();
# Find the visible map's centre
$centreXBlocks = ($startXBlocks + ($widthBlocks / 2) - 0.5);
$centreYBlocks = ($startYBlocks + ($heightBlocks / 2) - 0.5);
# Now, get the limits of a rectangle inside the visible window. The larger the
# sensitivity, the larger this rectangle. If the current room is outside this
# rectangle, the map needs to be centred
if ($sensitivity == 1) {
$insideStartXBlocks = $startXBlocks;
$insideStartYBlocks = $startYBlocks;
$insideStopXBlocks = ($startXBlocks + $widthBlocks - 1);
$insideStopYBlocks = ($startYBlocks + $heightBlocks - 1);
} else {
$insideStartXBlocks
= POSIX::ceil($centreXBlocks - (($widthBlocks / 2) * $sensitivity));
$insideStartYBlocks
= POSIX::ceil($centreYBlocks - (($heightBlocks / 2) * $sensitivity));
$insideStopXBlocks = int($centreXBlocks + (($widthBlocks / 2) * $sensitivity));
$insideStopYBlocks = int($centreYBlocks + (($heightBlocks / 2) * $sensitivity));
}
# Centre the map if the room is outside this rectangle
if (
$roomObj->xPosBlocks < $insideStartXBlocks
|| $roomObj->yPosBlocks < $insideStartYBlocks
|| $roomObj->xPosBlocks > $insideStopXBlocks
|| $roomObj->yPosBlocks > $insideStopYBlocks
) {
$centreFlag = TRUE;
}
}
if ($centreFlag) {
$self->centreMapOverRoom($roomObj);
# Update the regionmap, so that the new position is remembered
($scrollXPos, $scrollYPos) = $self->getMapPosn();
$self->currentRegionmap->ivPoke('scrollXPos', $scrollXPos);
$self->currentRegionmap->ivPoke('scrollYPos', $scrollYPos);
}
return 1;
}
sub paintRoom {
# Called by $self->enableModeColumn and ->repaintSelectedRoomsCallback
# Also called by GA::Obj::Map->createNewRoom, ->autoProcessNewRoom and ->useExistingRoom
#
# 'Paints' a room by transfering the values of certain IVs from the world model's painter
# object (a non-model GA::ModelObj::Room object) to the specified room (which IS in the
# world model)
# Scalar and list IVs are copied, replacing existing values; but hashes are merged. If the
# same key exists in both the specified room and the painter, the painter's key-value pair
# is used
#
# Also applies room flags specified by the world model's ->paintFromTitleHash,
# ->paintFromDescripHash (etc) IVs
#
# Expected arguments
# $roomObj - The room model object to 'paint'
#
# Optional arguments
# $updateFlag - If set to TRUE, calls the world model to tell it to redraw the room in
# every Automapper window; otherwise set to FALSE (or 'undef')
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $roomObj, $updateFlag, $check) = @_;
# Local variables
my (
$wmObj, $painterObj, $roomFlag, $checkFlag,
@ivList,
%checkHash, %usedHash,
);
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->paintRoom', @_);
}
# Import the world model and painter object (for convenience)
$wmObj = $self->worldModelObj;
$painterObj = $self->worldModelObj->painterObj;
# Import the list of IVs that are to be copied
@ivList = $self->worldModelObj->constPainterIVList;
foreach my $iv (@ivList) {
my (
$ivType,
%hash,
);
# Work out what kind of IV this is - scalar, list or hash
$ivType = ref $roomObj->{$iv};
# Hash IVs are merged
if ($ivType eq 'HASH') {
%hash = $painterObj->$iv;
foreach my $key (keys %hash) {
$roomObj->ivAdd($iv, $key, $hash{$key});
}
# List IVs are copied whole but only if they are not empty
} elsif ($ivType eq 'ARRAY') {
if ($painterObj->$iv) {
# Replace the existing list
$roomObj->{$iv} = $painterObj->{$iv};
}
# Scalar IVs are copied but only if they are defined
} elsif (defined $painterObj->$iv) {
$roomObj->{$iv} = $painterObj->{$iv};
}
}
# Compare patterns in the world model's painting IVs and, if they match this room, apply
# the corresponding room flag
# NB For titles only, if ->paintFromTitleHash contains multiple flags, they can all be set
# in the room
# After setting those flags, the code checks any flags in ->paintFromTitleHash that haven't
# just been set, and unsets them in the room
# This restriction prevents problems at worlds like EmpireMUD 2.0, whose room titles change
# as you chop down trees and dig up crops
# The keys in %checkHash are all the room flags in ->paintFromTitleHash
%checkHash = reverse $wmObj->paintFromTitleHash;
# Set room flags for any titles that match a pattern in ->paintFromTitleHash
OUTER: foreach my $pattern ($wmObj->ivKeys('paintFromTitleHash')) {
INNER: foreach my $title ($roomObj->titleList) {
if ($title =~ m/$pattern/) {
$roomFlag = $wmObj->ivShow('paintFromTitleHash', $pattern);
$roomObj->ivAdd('roomFlagHash', $roomFlag, undef);
# Remember which room flags we've set during this operation
$checkFlag = TRUE;
delete $checkHash{$roomFlag};
$usedHash{$roomFlag} = undef;
# No need to check the pattern against the remaining titles
next OUTER;
}
}
}
# If any room flags were set during this operation...
if ($checkFlag) {
# Unset any room flags in ->paintFromTitleHash that were not set during this operation
foreach my $key (%checkHash) {
if (! exists $usedHash{$key}) {
$roomObj->ivDelete('roomFlagHash', $key);
}
}
}
OUTER: foreach my $pattern ($wmObj->ivKeys('paintFromDescripHash')) {
INNER: foreach my $descrip ($roomObj->ivValues('descripHash')) {
if ($descrip =~ m/$pattern/) {
$roomObj->ivAdd(
'roomFlagHash',
$wmObj->ivShow('paintFromDescripHash', $pattern),
undef,
);
# No need to check the pattern against the remaining descriptions
next OUTER;
}
}
}
OUTER: foreach my $pattern ($wmObj->ivKeys('paintFromExitHash')) {
INNER: foreach my $exit ($roomObj->ivKeys('exitNumHash')) {
if ($exit =~ m/$pattern/) {
$roomObj->ivAdd(
'roomFlagHash',
$wmObj->ivShow('paintFromExitHash', $pattern),
undef,
);
# No need to check the pattern against the remaining exits
next OUTER;
}
}
}
OUTER: foreach my $pattern ($wmObj->ivKeys('paintFromObjHash')) {
INNER: foreach my $obj ($roomObj->tempObjList) {
if (
(defined $obj->baseString && $obj->baseString =~ m/$pattern/)
|| (
# Only check the noun, if the base string isn't defined (for some reason)
! defined $obj->baseString
&& defined $obj->noun
&& $obj->noun =~ m/$pattern/
)
) {
$roomObj->ivAdd(
'roomFlagHash',
$wmObj->ivShow('paintFromObjHash', $pattern),
undef,
);
# No need to check the pattern against the remaining objects
next OUTER;
}
}
}
OUTER: foreach my $pattern ($wmObj->ivKeys('paintFromRoomCmdHash')) {
INNER: foreach my $cmd ($roomObj->roomCmdList) {
if ($cmd =~ m/$pattern/) {
$roomObj->ivAdd(
'roomFlagHash',
$wmObj->ivShow('paintFromRoomCmdHash', $pattern),
undef,
);
# No need to check the pattern against the remaining room commands
next OUTER;
}
}
}
# Painting complete. If allowed, redraw the room in every Automapper window using this world
# model
if ($updateFlag) {
$self->worldModelObj->updateMaps('room', $roomObj);
}
return 1;
}
sub findOccupiedMap {
# Called by $self->regionScreenshotCallback
# Finds the boundaries of the regionmap occupied by rooms and labels on the current level
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments or if there are no rooms or labels on the current
# level of the current regionmap
# Otherwise a list of map coordinates - representing the boundaries (in pixels) of the
# smallest square containing all rooms and labels on the current level - in the form
# ($left, $right, $top, $bottom)
my ($self, $check) = @_;
# Local variables
my (
$left, $right, $top, $bottom,
@emptyList,
);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->findOccupiedMap', @_);
return @emptyList;
}
# Otherwise, go through each room in turn
foreach my $number ($self->currentRegionmap->ivValues('gridRoomHash')) {
my $roomObj = $self->worldModelObj->ivShow('modelHash', $number);
if ($roomObj->zPosBlocks == $self->currentRegionmap->currentLevel) {
if (! defined $left) {
# This is the first object so far
$left = $roomObj->xPosBlocks;
$right = $roomObj->xPosBlocks;
$top = $roomObj->yPosBlocks;
$bottom = $roomObj->yPosBlocks;
} else {
if ($roomObj->xPosBlocks < $left) {
$left = $roomObj->xPosBlocks;
}
if ($roomObj->xPosBlocks > $right) {
$right = $roomObj->xPosBlocks;
}
if ($roomObj->yPosBlocks < $top) {
$top = $roomObj->yPosBlocks;
}
if ($roomObj->yPosBlocks > $bottom) {
$bottom = $roomObj->yPosBlocks;
}
}
}
}
# Convert these boundaries from blocks to pixels
if (defined $left) {
$left *= $self->currentRegionmap->blockWidthPixels;
$right *= $self->currentRegionmap->blockWidthPixels;
$top *= $self->currentRegionmap->blockHeightPixels;
$bottom *= $self->currentRegionmap->blockHeightPixels;
}
# Now go through each label in turn
foreach my $labelObj ($self->currentRegionmap->ivValues('gridLabelHash')) {
if ($labelObj->level == $self->currentRegionmap->currentLevel) {
if (! defined $left) {
# This is the first object so far
$left = $labelObj->xPosPixels;
$right = $labelObj->xPosPixels;
$top = $labelObj->yPosPixels;
$bottom = $labelObj->yPosPixels;
} else {
if ($labelObj->xPosPixels < $left) {
$left = $labelObj->xPosPixels;
}
if ($labelObj->xPosPixels > $right) {
$right = $labelObj->xPosPixels;
}
if ($labelObj->yPosPixels < $top) {
$top = $labelObj->yPosPixels;
}
if ($labelObj->yPosPixels > $bottom) {
$bottom = $labelObj->yPosPixels;
}
}
}
}
# Can't do anything if there are no rooms or labels on the current level of the current
# regionmap
if (! defined $left) {
return @emptyList;
} else {
# Expand the boundaries by a couple of gridblocks in each direction, so that there's
# much less chance of anything being drawn outside them
# (Because occupied gridblocks are positioned at their top-left corners, we expand the
# right and bottom boundaries by 3 to compensate)
$left -= ($self->currentRegionmap->blockWidthPixels * 2);
if ($left < 0) {
$left = 0;
}
$right += ($self->currentRegionmap->blockWidthPixels * 3);
if (
$right >= (
$self->currentRegionmap->gridWidthBlocks
* $self->currentRegionmap->blockWidthPixels
)
) {
$right = (
$self->currentRegionmap->gridWidthBlocks
* $self->currentRegionmap->blockWidthPixels
) - 1;
}
$top -= ($self->currentRegionmap->blockHeightPixels * 2);
if ($top < 0) {
$top = 0;
}
$bottom += ($self->currentRegionmap->blockHeightPixels * 3);
if (
$bottom >= (
$self->currentRegionmap->gridHeightBlocks
* $self->currentRegionmap->blockHeightPixels
)
) {
$bottom = (
$self->currentRegionmap->gridHeightBlocks
* $self->currentRegionmap->blockHeightPixels
) - 1;
}
# Operation complete
return ($left, $right, $top, $bottom);
}
}
sub getAvailableDirs {
# Called by $self->allocateMapDirCallback
# Given a list of primary directions - either the usual list of ten, or the full list of
# eighteen - check a room's exits, to see which of these primary directions are not in
# use
#
# Expected arguments
# $roomObj - The parent room of $self->selectedExit
# @dirList - A list of primary directions
#
# Return values
# An empty list on improper arguments
# Otherwise returns a list in the form:
# (exit's_temporarily_allocated_dir, list_of_other_available_exits)
# ...where 'exit's_temporarily_allocated_dir' will be 'undef', if the exit has no
# allocated direction, and where list_of_other_available_exits will be an empty list,
# if none of the remaining primary directions in @dirList are available
my ($self, $roomObj, @dirList) = @_;
# Local variables
my (
$firstComboItem,
@emptyList, @comboList,
);
# Check for improper arguments
if (! defined $roomObj || ! @dirList) {
$axmud::CLIENT->writeImproper($self->_objClass . '->getAvailableDirs', @_);
return @emptyList;
}
# Prepare a list of primary direction exits which are still available
OUTER: foreach my $mapDir (@dirList) {
INNER: foreach my $exitNum ($roomObj->ivValues('exitNumHash')) {
my $exitObj = $self->worldModelObj->ivShow('exitModelHash', $exitNum);
if (
$exitObj->mapDir
&& $exitObj->mapDir eq $mapDir
&& ($exitObj->drawMode eq 'primary' || $exitObj->drawMode eq 'perm_alloc')
) {
# $mapDir isn't available
next OUTER;
}
}
# $mapDir is available. If it's the same as the selected exit's temporarily allocated
# map direction, we put that at the front of the list; otherwise, add it to the end
if (
$self->selectedExit->mapDir
&& $self->selectedExit->mapDir eq $mapDir
) {
$firstComboItem = $mapDir;
} else {
push (@comboList, $mapDir);
}
}
return ($firstComboItem, @comboList);
}
##################
# Accessors - set
sub set_freeClickMode {
my ($self, $mode, $check) = @_;
# Local variables
my $gdkWindow;
# Check for improper arguments
if (! defined $mode || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->set_freeClickMode', @_);
}
$self->ivPoke('freeClickMode', $mode);
if ($self->bgColourMode eq 'rect_stop') {
$self->ivPoke('bgColourMode', 'rect_start');
}
# Set the mouse icon accordingly
$gdkWindow = $self->winWidget->get_window();
if ($gdkWindow) {
if ($mode eq 'add_room' || $mode eq 'add_label') {
$gdkWindow->set_cursor($axmud::CLIENT->constMapAddCursor);
} elsif ($mode eq 'connect_exit' || $mode eq 'move_room') {
$gdkWindow->set_cursor($axmud::CLIENT->constMapConnectCursor);
} elsif ($mode eq 'merge_room') {
$gdkWindow->set_cursor($axmud::CLIENT->constMapMergeCursor);
} else {
$gdkWindow->set_cursor($axmud::CLIENT->constMapCursor);
}
}
return 1;
}
sub reset_freeClickMode {
my ($self, $check) = @_;
# Local variables
my $gdkWindow;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->reset_freeClickMode', @_);
}
$self->ivPoke('freeClickMode', 'default');
# Reset the mouse icon
$gdkWindow = $self->winWidget->get_window();
if ($gdkWindow) {
$gdkWindow->set_cursor($axmud::CLIENT->constMapCursor);
}
return 1;
}
sub set_ignoreMenuUpdateFlag {
my ($self, $flag, $check) = @_;
# Check for improper arguments
if (! defined $flag || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->set_ignoreMenuUpdateFlag',
@_,
);
}
if ($flag) {
$self->ivPoke('ignoreMenuUpdateFlag', TRUE);
} else {
$self->ivPoke('ignoreMenuUpdateFlag', FALSE);
}
return 1;
}
sub add_graffiti {
my ($self, $roomObj, $check) = @_;
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->add_graffiti', @_);
}
# Update IVs
if ($self->graffitiModeFlag) {
$self->ivAdd('graffitiHash', $roomObj->number);
# Update room counts in the window's title bar
$self->setWinTitle();
}
return 1;
}
sub del_graffiti {
my ($self, @roomList) = @_;
# (No improper arguments to check)
if ($self->graffitiModeFlag) {
foreach my $roomObj (@roomList) {
$self->ivDelete('graffitiHash', $roomObj->number);
}
# Update room counts in the window's title bar
$self->setWinTitle();
}
return 1;
}
sub set_mapObj {
my ($self, $mapObj, $check) = @_;
# Check for improper arguments
if (! defined $mapObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->set_mapObj', @_);
}
# Update IVs
$self->ivPoke('mapObj', $mapObj);
return 1;
}
sub set_pairedTwinExit {
my ($self, $exitObj, $check) = @_;
# Check for improper arguments
if (! defined $exitObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->set_pairedTwinExit', @_);
}
# Update IVs
$self->ivPoke('pairedTwinExit', $exitObj);
return 1;
}
sub set_pairedTwinRoom {
my ($self, $roomObj, $check) = @_;
# Check for improper arguments
if (! defined $roomObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->set_pairedTwinRoom', @_);
}
# Update IVs
$self->ivPoke('pairedTwinRoom', $roomObj);
return 1;
}
sub add_parchment {
my ($self, $parchmentObj, $check) = @_;
# Check for improper arguments
if (! defined $parchmentObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->add_parchment', @_);
}
# Update IVs
$self->ivAdd('parchmentHash', $parchmentObj->name, $parchmentObj);
return 1;
}
sub del_parchment {
my ($self, $name, $check) = @_;
# Local variables
my $count;
# Check for improper arguments
if (! defined $name || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->del_parchment', @_);
}
# Update IVs
$self->ivDelete('parchmentHash', $name);
$self->ivDelete('parchmentReadyHash', $name);
$count = -1;
OUTER: foreach my $obj ($self->parchmentQueueList) {
$count++;
if ($obj->name eq $name) {
$self->ivSplice('parchmentQueueList', $count, 1);
last OUTER;
}
}
return 1;
}
sub set_recentRegion {
# Called by GA::Obj::WorldModel->renameRegion
my ($self, $oldName, $newName, $check) = @_;
# Local variables
my @newList;
# Check for improper arguments
if (! defined $oldName || ! defined $newName || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->set_recentRegion', @_);
}
foreach my $name ($self->recentRegionList) {
if ($name eq $oldName) {
push (@newList, $newName)
} elsif ($name ne $newName) {
push (@newList, $name);
}
}
$self->ivPoke('recentRegionList', @newList);
# Must redraw the menu items that use ->recentRegionList
$self->redrawWidgets('menu_bar');
return 1;
}
sub reset_recentRegion {
# Called by GA::Obj::WorldModel->deleteRegions and ->deleteTempRegions
my ($self, @regionList) = @_;
# (No improper arguments to check)
# Inefficient code in the expectation that @regionList will rarely, if ever, contain more
# than one region
foreach my $regionObj (@regionList) {
my @newList;
foreach my $name ($self->recentRegionList) {
if ($name ne $regionObj->name) {
push (@newList, $name);
}
}
$self->ivPoke('recentRegionList', @newList);
}
# Must redraw the menu items that use ->recentRegionList
$self->redrawWidgets('menu_bar');
return 1;
}
sub set_worldModelObj {
my ($self, $worldModelObj, $check) = @_;
# Check for improper arguments
if (! defined $worldModelObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->set_worldModelObj', @_);
}
$self->ivPoke('worldModelObj', $worldModelObj);
# Reset the window, which avoids all kinds of problems
$self->winReset($self->session->mapObj);
return 1;
}
##################
# Accessors - get
sub mapObj
{ $_[0]->{mapObj} }
sub worldModelObj
{ $_[0]->{worldModelObj} }
sub menuBar
{ $_[0]->{menuBar} }
sub constButtonSetList
{ my $self = shift; return @{$self->{constButtonSetList}}; }
sub constButtonDescripHash
{ my $self = shift; return %{$self->{constButtonDescripHash}}; }
sub buttonSetHash
{ my $self = shift; return %{$self->{buttonSetHash}}; }
sub toolbarList
{ my $self = shift; return @{$self->{toolbarList}}; }
sub toolbarHash
{ my $self = shift; return %{$self->{toolbarHash}}; }
sub toolbarButtonList
{ my $self = shift; return @{$self->{toolbarButtonList}}; }
sub toolbarAddButton
{ $_[0]->{toolbarAddButton} }
sub toolbarSwitchButton
{ $_[0]->{toolbarSwitchButton} }
sub constToolbarDefaultSet
{ $_[0]->{constToolbarDefaultSet} }
sub toolbarOriginalSet
{ $_[0]->{toolbarOriginalSet} }
sub toolbarRoomFlagHash
{ my $self = shift; return %{$self->{toolbarRoomFlagHash}}; }
sub toolbarQuickPaintColour
{ $_[0]->{toolbarQuickPaintColour} }
sub menuToolItemHash
{ my $self = shift; return %{$self->{menuToolItemHash}}; }
sub hPaned
{ $_[0]->{hPaned} }
sub treeViewModel
{ $_[0]->{treeViewModel} }
sub treeView
{ $_[0]->{treeView} }
sub treeViewScroller
{ $_[0]->{treeViewScroller} }
sub treeViewWidthPixels
{ $_[0]->{treeViewWidthPixels} }
sub treeViewSelectedLine
{ $_[0]->{treeViewSelectedLine} }
sub treeViewRegionHash
{ my $self = shift; return %{$self->{treeViewRegionHash}}; }
sub treeViewPointerHash
{ my $self = shift; return %{$self->{treeViewPointerHash}}; }
sub canvas
{ $_[0]->{canvas} }
sub canvasBackground
{ $_[0]->{canvasBackground} }
sub canvasFrame
{ $_[0]->{canvasFrame} }
sub canvasScroller
{ $_[0]->{canvasScroller} }
sub canvasHAdjustment
{ $_[0]->{canvasHAdjustment} }
sub canvasVAdjustment
{ $_[0]->{canvasVAdjustment} }
sub canvasScrollerWidth
{ $_[0]->{canvasScrollerWidth} }
sub canvasScrollerHeight
{ $_[0]->{canvasScrollerHeight} }
sub canvasTooltipObj
{ $_[0]->{canvasTooltipObj} }
sub canvasTooltipObjType
{ $_[0]->{canvasTooltipObjType} }
sub canvasTooltipFlag
{ $_[0]->{canvasTooltipFlag} }
sub currentRegionmap
{ $_[0]->{currentRegionmap} }
sub currentParchment
{ $_[0]->{currentParchment} }
sub recentRegionList
{ my $self = shift; return @{$self->{recentRegionList}}; }
sub emptyMapFlag
{ $_[0]->{emptyMapFlag} }
sub winUpdateCalledFlag
{ $_[0]->{winUpdateCalledFlag} }
sub winUpdateForceFlag
{ $_[0]->{winUpdateForceFlag} }
sub winUpdateShowFlag
{ $_[0]->{winUpdateShowFlag} }
sub parchmentHash
{ my $self = shift; return %{$self->{parchmentHash}}; }
sub parchmentReadyHash
{ my $self = shift; return %{$self->{parchmentReadyHash}}; }
sub parchmentQueueList
{ my $self = shift; return @{$self->{parchmentQueueList}}; }
sub selectedRoom
{ $_[0]->{selectedRoom} }
sub selectedRoomTag
{ $_[0]->{selectedRoomTag} }
sub selectedRoomGuild
{ $_[0]->{selectedRoomGuild} }
sub selectedExit
{ $_[0]->{selectedExit} }
sub selectedExitTag
{ $_[0]->{selectedExitTag} }
sub selectedLabel
{ $_[0]->{selectedLabel} }
sub selectedRoomHash
{ my $self = shift; return %{$self->{selectedRoomHash}}; }
sub selectedRoomTagHash
{ my $self = shift; return %{$self->{selectedRoomTagHash}}; }
sub selectedRoomGuildHash
{ my $self = shift; return %{$self->{selectedRoomGuildHash}}; }
sub selectedExitHash
{ my $self = shift; return %{$self->{selectedExitHash}}; }
sub selectedExitTagHash
{ my $self = shift; return %{$self->{selectedExitTagHash}}; }
sub selectedLabelHash
{ my $self = shift; return %{$self->{selectedLabelHash}}; }
sub pairedTwinExit
{ $_[0]->{pairedTwinExit} }
sub pairedTwinRoom
{ $_[0]->{pairedTwinRoom} }
sub delayDrawFlag
{ $_[0]->{delayDrawFlag} }
sub quickDrawFlag
{ $_[0]->{quickDrawFlag} }
sub drawRegionmap
{ $_[0]->{drawRegionmap} }
sub drawParchment
{ $_[0]->{drawParchment} }
sub drawScheme
{ $_[0]->{drawScheme} }
sub selectDrawScheme
{ $_[0]->{selectDrawScheme} }
sub drawCycleExitHash
{ my $self = shift; return %{$self->{drawCycleExitHash}}; }
sub drawRoomTextSize
{ $_[0]->{drawRoomTextSize} }
sub drawRoomTextWidth
{ $_[0]->{drawRoomTextWidth} }
sub drawRoomTextHeight
{ $_[0]->{drawRoomTextHeight} }
sub drawOtherTextSize
{ $_[0]->{drawOtherTextSize} }
sub blockCornerXPosPixels
{ $_[0]->{blockCornerXPosPixels} }
sub blockCornerYPosPixels
{ $_[0]->{blockCornerYPosPixels} }
sub blockCentreXPosPixels
{ $_[0]->{blockCentreXPosPixels} }
sub blockCentreYPosPixels
{ $_[0]->{blockCentreYPosPixels} }
sub borderCornerXPosPixels
{ $_[0]->{borderCornerXPosPixels} }
sub borderCornerYPosPixels
{ $_[0]->{borderCornerYPosPixels} }
sub preDrawnIncompleteExitHash
{ my $self = shift; return %{$self->{preDrawnIncompleteExitHash}}; }
sub preDrawnUncertainExitHash
{ my $self = shift; return %{$self->{preDrawnUncertainExitHash}}; }
sub preDrawnLongExitHash
{ my $self = shift; return %{$self->{preDrawnLongExitHash}}; }
sub preDrawnSquareExitHash
{ my $self = shift; return %{$self->{preDrawnSquareExitHash}}; }
sub preCountCheckedHash
{ my $self = shift; return %{$self->{preCountCheckedHash}}; }
sub noObscuredRoomHash
{ my $self = shift; return %{$self->{noObscuredRoomHash}}; }
sub reObscuredRoomHash
{ my $self = shift; return %{$self->{reObscuredRoomHash}}; }
sub freeClickMode
{ $_[0]->{freeClickMode} }
sub ctrlKeyFlag
{ $_[0]->{ctrlKeyFlag} }
sub bgColourMode
{ $_[0]->{bgColourMode} }
sub bgColourChoice
{ $_[0]->{bgColourChoice} }
sub bgRectXPos
{ $_[0]->{bgRectXPos} }
sub bgRectYPos
{ $_[0]->{bgRectYPos} }
sub bgAllLevelFlag
{ $_[0]->{bgAllLevelFlag} }
sub exitSensitivity
{ $_[0]->{exitSensitivity} }
sub exitBendSize
{ $_[0]->{exitBendSize} }
sub exitClickXPosn
{ $_[0]->{exitClickXPosn} }
sub exitClickYPosn
{ $_[0]->{exitClickYPosn} }
sub leftClickTime
{ $_[0]->{leftClickTime} }
sub leftClickObj
{ $_[0]->{leftClickObj} }
sub leftClickWaitTime
{ $_[0]->{leftClickWaitTime} }
sub mode
{ $_[0]->{mode} }
sub showChar
{ $_[0]->{showChar} }
sub painterFlag
{ $_[0]->{painterFlag} }
sub graffitiModeFlag
{ $_[0]->{graffitiModeFlag} }
sub graffitiHash
{ my $self = shift; return %{$self->{graffitiHash}}; }
sub constVectorHash
{ my $self = shift; return %{$self->{constVectorHash}}; }
sub constDoubleVectorHash
{ my $self = shift; return %{$self->{constDoubleVectorHash}}; }
sub constArrowVectorHash
{ my $self = shift; return %{$self->{constArrowVectorHash}}; }
sub constPerpVectorHash
{ my $self = shift; return %{$self->{constPerpVectorHash}}; }
sub constSpecialVectorHash
{ my $self = shift; return %{$self->{constSpecialVectorHash}}; }
sub constTriangleCornerHash
{ my $self = shift; return %{$self->{constTriangleCornerHash}}; }
sub constGtkAnchorHash
{ my $self = shift; return %{$self->{constGtkAnchorHash}}; }
sub constMagnifyList
{ my $self = shift; return @{$self->{constMagnifyList}}; }
sub constShortMagnifyList
{ my $self = shift; return @{$self->{constShortMagnifyList}}; }
sub ignoreMenuUpdateFlag
{ $_[0]->{ignoreMenuUpdateFlag} }
sub dragModeFlag
{ $_[0]->{dragModeFlag} }
sub dragFlag
{ $_[0]->{dragFlag} }
sub dragContinueFlag
{ $_[0]->{dragContinueFlag} }
sub dragCanvasObj
{ $_[0]->{dragCanvasObj} }
sub dragCanvasObjList
{ my $self = shift; return @{$self->{dragCanvasObjList}}; }
sub dragModelObj
{ $_[0]->{dragModelObj} }
sub dragModelObjType
{ $_[0]->{dragModelObjType} }
sub dragInitXPos
{ $_[0]->{dragInitXPos} }
sub dragInitYPos
{ $_[0]->{dragInitYPos} }
sub dragCurrentXPos
{ $_[0]->{dragCurrentXPos} }
sub dragCurrentYPos
{ $_[0]->{dragCurrentYPos} }
sub dragFakeRoomList
{ my $self = shift; return @{$self->{dragFakeRoomList}}; }
sub dragBendNum
{ $_[0]->{dragBendNum} }
sub dragBendInitXPos
{ $_[0]->{dragBendInitXPos} }
sub dragBendInitYPos
{ $_[0]->{dragBendInitYPos} }
sub dragBendTwinNum
{ $_[0]->{dragBendTwinNum} }
sub dragBendTwinInitXPos
{ $_[0]->{dragBendTwinInitXPos} }
sub dragBendTwinInitYPos
{ $_[0]->{dragBendTwinInitYPos} }
sub dragExitDrawMode
{ $_[0]->{dragExitDrawMode} }
sub dragExitOrnamentsFlag
{ $_[0]->{dragExitOrnamentsFlag} }
sub selectBoxFlag
{ $_[0]->{selectBoxFlag} }
sub selectBoxCanvasObj
{ $_[0]->{selectBoxCanvasObj} }
sub selectBoxInitXPos
{ $_[0]->{selectBoxInitXPos} }
sub selectBoxInitYPos
{ $_[0]->{selectBoxInitYPos} }
sub selectBoxCurrentXPos
{ $_[0]->{selectBoxCurrentXPos} }
sub selectBoxCurrentYPos
{ $_[0]->{selectBoxCurrentYPos} }
}
# Package must return a true value
1