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
if ($host && $port) {
$result
= $self->session->pseudoCmd('telnet ' . $host . ' ' . $port);
} else {
$result = $self->session->pseudoCmd('telnet ' . $host);
}
}
} elsif ($self->currentLinkObj->type eq 'ssh') {
# The link should be in the form ssh://deathmud.org:6666 or
# ssh://deathmud.org
# Separate that into a host and a port
if ($self->currentLinkObj->href =~ m/^ssh\:\/\/([^\:\s]+)(\:(\d+))?/) {
$host = $1;
$port = $3; # May be 'undef';
if ($host && $port) {
$result = $self->session->pseudoCmd('ssh ' . $host . ' ' . $port);
} 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();
lib/Games/Axmud/Obj/TextView.pm view on Meta::CPAN
# 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
# Only change the cursor, if the mouse has moved from a link to normal space, or vice-versa;
# of if the mouse has moved from one link to another
$window = $textView->get_window('text');
if (! $hoverFlag && $self->currentLinkObj) {
# Reset the cursor
$self->ivUndef('currentLinkObj');
$window->set_cursor($axmud::CLIENT->constNormalCursor);
# Hide tooltips
$self->hideTooltips();
} elsif ($hoverFlag) {
# Find the corresponding GA::Obj::Link
$listRef = $self->ivShow('linkObjLineHash', $lineNum + $self->nextDeleteLine);
if (defined $listRef) {
OUTER: foreach my $thisLinkObj (@$listRef) {
my $endPosn = $thisLinkObj->posn + length ($thisLinkObj->text);
if ($posn >= $thisLinkObj->posn && $posn < $endPosn) {
# Found the corresponding GA::Obj::Link
$linkObj = $thisLinkObj;
last OUTER;
}
}
}
if (! $linkObj) {
# Mouse is not above a link (or error finding a link)
$self->ivUndef('currentLinkObj');
$window->set_cursor($axmud::CLIENT->constNormalCursor);
# Hide tooltips
$self->hideTooltips();
} elsif (! $self->currentLinkObj || $self->currentLinkObj ne $linkObj) {
# Mouse is above a new link
if ($linkObj->expiredFlag) {
# It's an expired link
$self->ivUndef('currentLinkObj');
$window->set_cursor($axmud::CLIENT->constNormalCursor);
# Hide tooltips
$self->hideTooltips();
} else {
# Not an expired link
$self->ivPoke('currentLinkObj', $linkObj);
if ($linkObj->type eq 'www') {
$window->set_cursor($axmud::CLIENT->constWWWCursor);
} elsif ($linkObj->type eq 'cmd') {
# (Check ->popupFlag first, because a popup menu can also redirect to a
# prompt)
if ($linkObj->popupFlag) {
$window->set_cursor($axmud::CLIENT->constPopupCursor);
} elsif ($linkObj->mxpPromptFlag) {
$window->set_cursor($axmud::CLIENT->constPromptCursor);
} else {
$window->set_cursor($axmud::CLIENT->constCmdCursor);
}
} elsif ($linkObj->type eq 'mail') {
$window->set_cursor($axmud::CLIENT->constMailCursor);
} elsif (
$linkObj->type eq 'telnet'
|| $linkObj->type eq 'ssh'
|| $linkObj->type eq 'ssl'
) {
$window->set_cursor($axmud::CLIENT->constTelnetCursor);
} elsif ($linkObj->type eq 'image') {
$axmud::CLIENT->writeDebug(
'Mouse above image link; examine code please',
$self->_objClass . '->checkMousePosn',
);
} elsif ($linkObj->type eq 'other') {
$window->set_cursor($axmud::CLIENT->constNormalCursor);
}
# If it's an MXP link with a hint, show the hint in the tooltip window
if ($linkObj->hint) {
# Unhide the tooltips window and display $linkObj's ->hint
$self->showLinkTooltips($linkObj);
$tooltipsFlag = TRUE;
} else {
# Hide the tooltips window
$self->hideTooltips();
}
}
}
}
# If there's no link tooltip visible, consider showing the session tooltip instead
if ($axmud::CLIENT->mainWinTooltipFlag && ! $tooltipsFlag && ! $self->currentLinkObj) {
# Only lines created by the GA::Session, and displayed in its default textview object,
# cause key-value pairs to be added to this hash
# NB 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->ivExists('tooltipHash', ($lineNum + $self->nextDeleteLine))) {
$self->showSessionTooltips($lineNum + $self->nextDeleteLine);
} elsif ($self->lastTooltipLine) {
$self->hideTooltips();
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 0.870 second using v1.01-cache-2.11-cpan-364913b4093 )