Games-Axmud
view release on metacpan or search on metacpan
lib/Games/Axmud/Obj/TextView.pm view on Meta::CPAN
# $paneObj - For textview objects that will be added to the Gtk3::Grid in an 'internal'
# window (specifically, added directly to a GA::Strip::Table object), that
# GA::Strip::Table object. Set to 'undef' for a textview object created
# for any other reason
#
# Return values
# 'undef' on improper arguments
# Blessed reference to the newly-created object on success
my ($class, $session, $number, $winObj, $paneObj, $check) = @_;
# Local variables
my %colourStyleHash;
# Check for improper arguments
if (
! defined $class || ! defined $session || ! defined $number || ! defined $winObj
|| defined $check
) {
return $axmud::CLIENT->writeImproper($class . '->new', @_);
}
# Import constant hash with inintial values we need
%colourStyleHash = $axmud::CLIENT->constColourStyleHash;
# Setup
my $self = {
_objName => 'textview_' . $number,
_objClass => $class,
_parentFile => undef, # No parent file object
_parentWorld => undef, # No parent file object
_privFlag => TRUE, # All IVs are private
# IVs
# ---
# The GA::Session which controls this textview
session => $session,
# Unique number for this textview object across all sessions (matches
# GA::Obj::Desktop->textViewCount)
number => $number,
# The window object (inheriting from GA::Generic::Win) in which this object's
# textview(s) are displayed
winObj => $winObj,
# For textview objects that will be added to the Gtk3::Grid in an 'internal' window
# (specifically, added directly to a GA::Strip::Table object), that
# GA::Strip::Table object. Set to 'undef' for a textview object created for any
# other reason
paneObj => $paneObj,
# Widgets
textView => undef, # Gtk3::TextView
textView2 => undef, # Gtk3::TextView
buffer => undef, # Gtk3::TextBuffer
vPaned => undef, # Gtk3::VPaned
scroll => undef, # Gtk3::ScrolledWindow
scroll2 => undef, # Gtk3::ScrolledWindow
startMark => undef, # Gtk3::TextMark
endMark => undef, # Gtk3::TextMark
searchMark => undef, # Gtk3::TextMark
popupMenu => undef, # Gtk3::Menu
# Other IVs
# Flag set to TRUE when the scroll lock is enabled, FALSE when it is disabled (only
# applies to the original Gtk3::TextView)
scrollLockFlag => TRUE,
# What type of scroll lock to apply - 'top' if the original textview should remain
# scrolled to the top, 'bottom' if it should remain scrolled to the bottom
scrollLockType => 'bottom',
# Split screen mode. Because of performance issues with very large Gtk3::TextBuffers,
# if the user is likely to want a split screen (with two Gtk3::TextView, separated by
# a divider and sharing the same Gtk3::TextBuffer), it's usually better to create both
# Gtk3::TextViews when this textview object is created, rather than starting with a
# single textview and creating (or destroying) the second one as need be
# This IV is set to the current split screen mode, and is updated whenever the mode is
# changed via calls to $self->setSplitScreenMode:
# 'single' - Only one Gtk3::TextView
# 'split' - Two Gtk3::TextViews with a divider between them, positioned so
# they are both visible
# 'hidden' - Two Gtk3::TextViews with a divider between them, positioned at the
# top of the screen so the second textview is invisible (and the
# divider itself is almost invisible); however, the user is free
# to move it manually, and when they do so, the IV remains set to
# 'hidden')
splitScreenMode => 'single',
# The colour scheme applied to this textview object (matches a key in
# GA::Client->colourSchemeHash)
# To apply a colour scheme, the textview object must not be called directly; instead,
# call $self->paneObj->updateColourScheme, ->applyColourScheme, ->applyMonochrome or
# ->removeMonochrome
colourScheme => undef,
# The text colours
textColour => undef,
underlayColour => undef,
backgroundColour => undef,
# The font and fontsize
font => undef,
fontSize => undef,
# Some parts of the code (for example the Status task) want to use a textview with only
# two colours - text and background. This is called 'monochrome mode'
# Set to TRUE on the first call to $self->setMonochromeMode which changes the textview's
# background colour to a specified colour, and chooses suitable text/underlay colours
# (for example, specify 'blue' for white text on a blue background). The colours can
# be changed any time with further calls to ->setMonochromeMode
# When TRUE, calls to ->insertText and ->showSystemText ignore any Axmud colour tags
# that are specified (but not Axmud style tags, which are processed as usual). Calls
# to ->insertCmd, ->showError, ->showWarning, ->showDebug, ->showImproper do not use
# their normal text colours
# When TRUE, the colour scheme only changes on calls to ->setMonochromeMode. It doesn't
# change when a new colour scheme is applied (via a call to $self->objUpdate, itself
# called by GA::Table::Pane->applyColourScheme)
# Set back to FALSE by a call to $self->resetMonochromeMode, at which point the colour
# scheme stored in $self->colourScheme is applied (it might have changed since this
# flag was first set to TRUE)
monochromeFlag => FALSE,
# In monochrome mode, we need to know when the colours used are the same as those
# specified by the colour scheme, and when they're different (because if the colour
# scheme's colours change, by the time $self->objUpdate is called, there is no way
# of comparing the colour scheme's previous colours to the colours currently used in
lib/Games/Axmud/Obj/TextView.pm view on Meta::CPAN
} else {
$result = $self->session->pseudoCmd('ssh ' . $host);
}
}
} elsif ($self->currentLinkObj->type eq 'ssl') {
# The link should be in the form ssl://deathmud.org:6666 or
# ssl://deathmud.org
# Separate that into a host and a port
if ($self->currentLinkObj->href =~ m/^ssl\:\/\/([^\:\s]+)(\:(\d+))?/) {
$host = $1;
$port = $3; # May be 'undef';
if ($host && $port) {
$result = $self->session->pseudoCmd('ssl ' . $host . ' ' . $port);
} else {
$result = $self->session->pseudoCmd('ssl ' . $host);
}
}
} elsif ($self->currentLinkObj->type eq 'cmd') {
if ($self->currentLinkObj->mxpPromptFlag) {
# Instead of sending a world command, copy the world command into the
# 'main' window's entry box
$stripObj = $self->paneObj->winObj->getStrip('entry');
if ($stripObj) {
$result = $stripObj->commandeerEntry(
$self->session,
$self->currentLinkObj->href,
);
}
} elsif ($self->currentLinkObj->popupCmdList) {
$result = $self->session->worldCmd(
$self->currentLinkObj->ivFirst('popupCmdList'),
);
} elsif ($self->currentLinkObj->href) {
$result = $self->session->worldCmd($self->currentLinkObj->href);
} else {
$result = $self->session->worldCmd($self->currentLinkObj->text);
}
}
# Right button
} elsif ($event->button == 3) {
if ($self->currentLinkObj->type eq 'cmd' && $self->currentLinkObj->popupFlag) {
# Create a popup menu, and send a world command if the user clicks on a menu
# item
$result = $self->createPopupMenu($event);
}
}
# Clicking on a link resets the cursor
$self->ivUndef('currentLinkObj');
$textView->get_window('text')->set_cursor($axmud::CLIENT->constNormalCursor);
return $result;
}
# Otherwise return 'undef' to show that we haven't interfered with the widget
return undef;
});
return 1;
}
sub setTextViewScrollEvent {
# Called by $self->enableSplitScreen and ->enableHiddenSplitScreen, as well as by
# GA::Table::Pane->addSimpleTab and ->addTab
# Set up a ->signal_connect to watch out for scrolling in the Gtk3::ScrolledWindow which
# contains a textview
#
# Expected arguments
# $scroll - The Gtk3::ScrolledWindow that generated the signal
# $textView - The Gtk3::TextView it contains
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $scroll, $textView, $check) = @_;
# Check for improper arguments
if (! defined $scroll || ! defined $textView || defined $check) {
return $axmud::CLIENT->writeImproper(
$self->_objClass . '->setTextViewScrollEvent',
@_,
);
}
# Detect scrolling, so we can reset the cursor (so the user can't move the cursor above a
# link, wait until the link scrolls away, and then still click the link)
my $adjust = $scroll->get_vadjustment();
$adjust->signal_connect('value-changed' => sub {
my $window = $textView->get_window('text');
if ($self->currentLinkObj) {
$self->ivUndef('currentLinkObj');
$window->set_cursor($axmud::CLIENT->constNormalCursor);
}
# (Any scrolling in the window hides tooltips)
$self->hideTooltips();
# Without this line, changes to the visible textview size, caused by the addition/
# removal of a scrollbar, are applied quickly enough
lib/Games/Axmud/Obj/TextView.pm view on Meta::CPAN
return $axmud::CLIENT->writeImproper($self->_objClass . '->hideTooltips', @_);
}
# Hide the tooltips window
$self->textView->set_tooltip_text('');
if ($self->textView2) {
$self->textView2->set_tooltip_text('');
}
# Update IVs
$self->ivUndef('lastTooltipLine');
return 1;
}
sub useDisplayBufferNum {
# Called by GA::Session->processLineSegment (only)
# The calling function is informing us that this textview object is its default textview
# object, that it's about to call ->insertText, and that we should make a note of the
# session's current display buffer line number, so we can display our tooltips correctly
#
# Expected arguments
# $sessionLineNum - The session's display buffer line number (matching
# GA::Session->displayBufferCount)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $sessionLineNum, $check) = @_;
# Local variables
my $iter;
# Check for improper arguments
if (! defined $sessionLineNum || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->useDisplayBufferNum', @_);
}
# The hash only needs to be updated, once per line of non-system message text
# The Gtk3::Textbuffer renumbers its line every time we delete one from the beginning of the
# buffer, so here we must add $self->nextDeleteLine
if (! $self->insertMark && $self->newLineFlag) {
$iter = $self->buffer->get_end_iter();
$self->ivAdd(
'tooltipHash',
($iter->get_line() + $self->nextDeleteLine),
'Line ' . $sessionLineNum . ', ' . $axmud::CLIENT->localTime,
);
}
return 1;
}
sub createPopupMenu {
# Called by ->signal_connect in $self->setButtonPressEvent
# After the user has clicked on $self->currentLinkObj, creates a popup menu from which the
# user can select one of several menu items. If the user clicks on a menu item, the
# corresponding world command is sent
# The menu options and corresponding world commands are (usually) set by an MXP
# <SEND>..</SEND> construction
#
# Expected arguments
# $event - The 'button_press_event' signal emitted when the user clicks on a
# clickable link in the tab
#
# Return values
# 'undef' on improper arguments or if the popup menu can't be created
# 1 otherwise
my ($self, $event, $check) = @_;
# Local variables
my (
$linkObj, $count,
@optionList,
);
# Check for improper arguments
if (! defined $event || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->createPopupMenu', @_);
}
# Check there is a current link object set (no reason why there shouldn't be)
if (! $self->currentLinkObj) {
return undef;
} else {
# $self->currentLinkObj will be set to 'undef' as soon as the popup menu is clicked,
# and before this function returns, so store the object as a local variable)
$linkObj = $self->currentLinkObj;
}
# Create the popup menu
my $menu = Gtk3::Menu->new();
# The GA::Obj::Link stores menu items and corresponding world commands each as a single
# string, with items/commands separated by a | character
# (If there was an extra item in @optionList, representing an extra tooltip hint to show
# e.g. "Click to see the menu", it has already been removed)
@optionList = $linkObj->popupItemList;
$count = -1;
foreach my $cmd ($linkObj->popupCmdList) {
my ($hint, $menuItem);
$count++;
# Prefer to use a hint over a raw command, if a hint was supplied
$hint = shift (@optionList);
$menuItem = Gtk3::MenuItem->new_with_label('');
my $label = $menuItem->get_child();
if ($hint) {
if (! $count) {
$label->set_markup('<b>' . $hint . '</b>');
} else {
$label->set_markup($hint);
}
} else {
if (! $count) {
$label->set_markup('<b>' . $cmd . '</b>');
} else {
$label->set_markup($cmd);
}
}
$menu->append($menuItem);
$menuItem->signal_connect('activate' => sub {
my $stripObj = $self->paneObj->winObj->getStrip('entry');
if ($linkObj->mxpPromptFlag && $stripObj) {
$stripObj->commandeerEntry($self->session, $cmd);
} else {
$self->session->worldCmd($cmd);
}
});
}
$menu->popup(
undef, undef, undef, undef,
$event->button,
$event->time,
);
$menu->show_all();
# Store as an IV, so that $self->resetCurrentLink can destroy it, if the link expires
$self->ivPoke('popupMenu', $menu);
$menu->signal_connect('delete-event' => sub {
$self->ivUndef('popupMenu');
return undef;
});
return 1;
}
sub resetCurrentLink {
# Called by GA::Session->processMxpOfficialElement when the GA::Obj::Link object stored in
# $self->currentLinkObj expires
# Hides tooltips, resets the cursor, closes the popup menu
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if this isn't the 'main' window
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetCurrentLink', @_);
}
# Hide tooltips, if visible
$self->hideTooltips();
# Reset the cursor
if ($self->textView) {
$self->textView->get_window('text')->set_cursor($axmud::CLIENT->constNormalCursor);
}
# Close the popup menu
if ($self->popupMenu) {
$self->popupMenu->destroy();
$self->ivUndef('popupMenu');
}
return 1;
}
sub toggleScrollLock {
# Called by GA::Table::Pane->toggleScrollLock
# Enables or disables this textview object's scroll lock mode, in which the textview scrolls
# to the bottom every time text is received from the world. (If split screen mode is
# enabled, only the original lower textview scrolls)
#
# 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 . '->toggleScrollLock', @_);
}
if (! $self->scrollLockFlag) {
$self->ivPoke('scrollLockFlag', TRUE);
# Scroll to the beginning/end of the buffer in the (original) textview immediately
if ($self->scrollLockType eq 'top') {
$self->scrollToTop();
} else {
$self->scrollToBottom();
}
} else {
$self->ivPoke('scrollLockFlag', FALSE);
$self->winObj->winShowAll($self->_objClass . '->toggleScrollLock');
}
# Operation complete
return 1;
}
sub setSplitScreenMode {
# Called by GA::Table::Pane->convertSimpleTab, ->convertTab and ->toggleSplitScreen
# Sets this textview object's split screen mode, adding or removing a second textview and
# repositioning the divider between two textviews as required
# This is a convenience function. Axmud code is free to call $self->enableSingleScreen,
# ->enableSplitScreen or ->enableHiddenSplitScreen directly, if preferred
#
# Expected arguments
# $mode - One of the recognised values for $self->splitScreenMode, i.e. 'single',
# 'split' or 'hidden'
lib/Games/Axmud/Obj/TextView.pm view on Meta::CPAN
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->reset_scrlRegion', @_);
}
$self->ivUndef('scrlRegionTop');
$self->ivUndef('scrlRegionBottom');
return 1;
}
sub set_sizeUpdateFlag {
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->set_sizeUpdateFlag', @_);
}
$self->ivPoke('sizeUpdateFlag', TRUE);
return 1;
}
##################
# Accessors - get
sub session
{ $_[0]->{session} }
sub number
{ $_[0]->{number} }
sub winObj
{ $_[0]->{winObj} }
sub paneObj
{ $_[0]->{paneObj} }
sub textView
{ $_[0]->{textView} }
sub textView2
{ $_[0]->{textView2} }
sub buffer
{ $_[0]->{buffer} }
sub vPaned
{ $_[0]->{vPaned} }
sub scroll
{ $_[0]->{scroll} }
sub scroll2
{ $_[0]->{scroll2} }
sub startMark
{ $_[0]->{startMark} }
sub endMark
{ $_[0]->{endMark} }
sub searchMark
{ $_[0]->{searchMark} }
sub popupMenu
{ $_[0]->{popupMenu} }
sub scrollLockFlag
{ $_[0]->{scrollLockFlag} }
sub scrollLockType
{ $_[0]->{scrollLockType} }
sub splitScreenMode
{ $_[0]->{splitScreenMode} }
sub colourScheme
{ $_[0]->{colourScheme} }
sub textColour
{ $_[0]->{textColour} }
sub underlayColour
{ $_[0]->{underlayColour} }
sub backgroundColour
{ $_[0]->{backgroundColour} }
sub font
{ $_[0]->{font} }
sub fontSize
{ $_[0]->{fontSize} }
sub monochromeFlag
{ $_[0]->{monochromeFlag} }
sub monochromeModFlag
{ $_[0]->{monochromeModFlag} }
sub overwriteFlag
{ $_[0]->{overwriteFlag} }
sub maxLines
{ $_[0]->{maxLines} }
sub nextDeleteLine
{ $_[0]->{nextDeleteLine} }
sub scrlRegionTop
{ $_[0]->{scrlRegionTop} }
sub scrlRegionBottom
{ $_[0]->{scrlRegionBottom} }
sub bufferTextFlag
{ $_[0]->{bufferTextFlag} }
sub sizeUpdateFlag
{ $_[0]->{sizeUpdateFlag} }
sub textWidthChars
{ $_[0]->{textWidthChars} }
sub textHeightChars
{ $_[0]->{textHeightChars} }
sub newLineFlag
{ $_[0]->{newLineFlag} }
sub insertNewLineFlag
{ $_[0]->{insertNewLineFlag} }
sub newLineDefault
{ $_[0]->{newLineDefault} }
sub clearAfterInsertFlag
{ $_[0]->{clearAfterInsertFlag} }
sub insertMark
{ $_[0]->{insertMark} }
sub restoreInsertMark
{ $_[0]->{restoreInsertMark} }
sub tempInsertMark
{ $_[0]->{tempInsertMark} }
( run in 1.530 second using v1.01-cache-2.11-cpan-39bf76dae61 )