Gtk2::Ex::Dragger - drag to move adjustment position
Index
- NAME
- SYNOPSIS
- DESCRIPTION
- FUNCTIONS
-
- PROPERTIES
-
widget (Gtk2::Widget, default undef)hadjustment (Gtk2::Adjustment object, default undef)vadjustment (Gtk2::Adjustment object, default undef)hinverted (boolean, default false)vinverted (boolean, default false)cursor (scalar, default undef)cursor-name (string, cursor enum nick or "invisible", default undef)cursor-object (Gtk2::Gdk::Cursor, default undef)confine (boolean, default false)update-policy (UpdatePolicy enum, default "sync")
- UPDATE POLICY
-
- OTHER NOTES
- BUILDABLE
- SEE ALSO
- HOME PAGE
- LICENSE
Code Index:
NAME
Gtk2::Ex::Dragger -- drag to move adjustment position
SYNOPSIS
use Gtk2::Ex::Dragger;
Gtk2::Ex::Dragger->new (widget => $widget,
hadjustment => $widget->get_hadjustment);
DESCRIPTION
Gtk2::Ex::Dragger implements mouse pointer dragging to move the contents
of a widget horizontally, vertically, or both. It works on any windowed
widget which has Gtk2::Adjustment objects controlling the visible part.
The width or height of the widget corresponds to the "page" in the
adjustment. Dragger scales pixel movement onto the adjustment "value"
accordingly. It's then up to the usual widget drawing to follow
value-changed signals from the adjustment for redraws, the same as for
scrollbars etc. The effect for the user is that the contents are pulled
around with the mouse.
Adjustment
+--+ --upper
| |
Window | |
+-------------+ \ | |
| | \| |
| | +--+ \_ page size
| | | | /
| | +--+ ___ value
| | /| |
+-------------+ / | |
| |
| |
+--+ --lower
If you've got scrollbars then they move with the dragging too. It can be
good to have both ways of moving since the scrollbars give visual feedback
but dragging allows finer movements if the visible page is a very small part
of the total adjustable extent.
The "confine" option lets you to restrict mouse movement to screen positions
corresponding to the adjustment upper/lower, so the user gets an obvious
feedback at the limits.
The "cursor" option changes the mouse pointer cursor while dragging. This
is good if it's not clear for a given widget which button press etc
activates a drag. The cursor is set through WidgetCursor (see
Gtk2::Ex::WidgetCursor) and so cooperates with other uses of that. See
examples/heart.pl in the Gtk2-Ex-Dragger sources, or examples/busy.pl
for the global "busy" indication.
Dragger can work on both natively scrollable widgets and widgets put into a
Gtk2::Viewport. For a viewport it's the viewport widget which is passed
to the dragger since that's the widget showing a portion of a larger
underlying thing. (Eg. examples/textview.pl natively or
examples/label.pl and examples/layout.pl in a Viewport or Layout, and
examples/vruler.pl with separately jigged up adjusters.)
Changes to the adjustment value, upper/lower, page size, or the widget
window size are all allowed during a drag. A change to the value could come
from a keyboard page-up etc. In all cases the Dragger continues relative to
the new position and will update any "confine" window limits.
Event Mask
The dragger adds the following events mask bits to the target widget. It
uses the WidgetEvents mechanism (see Gtk2::Ex::WidgetEvents) so they're
cleaned up if the dragger is destroyed.
button-press-mask
button-motion-mask
button-release-mask
The dragger doesn't itself have a button press handler (at present), rather
an application is expected to start the drag for some button/modifier
combination. The dragger adds the press mask in readiness for that.
If you want to defer dragger creation until actually needed in a button
press then you must explicitly select the motion and release events
beforehand. For example,
# events selected beforehand
$widget->add_events (['button-press-mask',
'button-motion-mask',
'button-release-mask']);
# dragger not created until actually wanted
sub my_button_press_handler {
my ($widget, $event) = @_;
if (some_thing()) {
require Gtk2::Ex::Dragger;
$dragger = Gtk2::Ex::Dragger->new (...);
$dragger->start ($event);
}
}
The motion and release masks beforehand are important if the application is
lagged. It's possible the user has already released when the application
receives the press. If the release mask wasn't already on then the release
event is not generated. If you forget those masks then currently the
dragger turns on but then doesn't work and won't turn off (either all the
time, or when lagged, or the first use).
FUNCTIONS
Gtk2::Ex::Dragger->new (key=>value, ...)-
Create and return a new dragger. Key/value pairs set the following various
parameters,
widget the widget to drag
hadjustment Gtk2::Adjustment
vadjustment Gtk2::Adjustment
hinverted boolean
vinverted boolean
cursor cursor name per Gtk2::Ex::WidgetCursor
confine boolean
update_policy string (see UPDATE POLICY below)
The target widget and at least one of hadjustment or vadjustment
are mandatory, the rest are options.
The hinverted or vinverted flags swap the direction the adjustments
are moved. Normally hadjustment increases to the left and vadjustment
increases upwards. Inverting goes instead to the right or downwards. This
is the same sense as inverted on Gtk2::Scrollbar, so if you set
inverted on the scrollbar then do the same to the dragger.
cursor is any cursor name or object accepted by the WidgetCursor
mechanism (see Gtk2::Ex::WidgetCursor). If unset or undef (the
default) then the cursor is unchanged and you don't need WidgetCursor
installed in that case.
$dragger->start ($event)-
Begin a drag. $event must be a Gtk2::Gdk::Event::Button object; it
gives the button doing the drag and the server timestamp.
$dragger->stop ()$dragger->stop ($event)-
Stop $dragger, if it's active. Normally a dragger stops by itself when
the dragging button is released, but this method can be do it sooner.
If you stop in response to a Gtk2::Gdk::Event then pass that so its
timestamp can be used. This matters when the dragger uses an active grab.
If application event processing is a bit lagged the timestamp ensures the
ungrab doesn't kill a later passive grab on a button press or an explicit
grab by another client.
PROPERTIES
widget (Gtk2::Widget, default undef)-
The widget whose contents are to be dragged around.
Currently if widget is changed while a drag is in progress then the drag
is stopped. In the future it may be possible to switch, though doing so
would be a bit unusual.
hadjustment (Gtk2::Adjustment object, default undef)vadjustment (Gtk2::Adjustment object, default undef)-
The adjustment objects representing the current position and range of
movement in the respective directions. Nothing will move until at least one
of these two is set.
hinverted (boolean, default false)vinverted (boolean, default false)-
Swap the direction the respective adjustments are moved. Normally
hadjustment increases to the left and vadjustment increases upwards.
Inverting goes instead to the right or downwards. These are the same way
around as the Gtk2::Scrollbar inverted property so if you set
inverted on the scrollbar then do the same to the dragger.
cursor (scalar, default undef)cursor-name (string, cursor enum nick or "invisible", default undef)cursor-object (Gtk2::Gdk::Cursor, default undef)-
cursor is any cursor name or object accepted by the WidgetCursor
mechanism (see Gtk2::Ex::WidgetCursor). If unset or undef (the
default) then the cursor is unchanged and you don't need WidgetCursor
installed in that case.
The cursor-name and cursor-object properties access the same
underlying cursor setting but with respective string or cursor object
type. They can be used from a Gtk2::Builder specification.
confine (boolean, default false)-
Whether to confine the user's mouse movement to the screen area
corresponding to the adjustment upper/lower ranges.
update-policy (UpdatePolicy enum, default "sync")-
See UPDATE POLICY above.
UPDATE POLICY
The update_policy option (a string) controls how often value-changed
signals are emitted on the adjustments. The dragger always stores updated
values in the adjustments immediately (and emits notify), but it can be
configured to defer the value-changed signal. This is similar to the way
scrollbars work (see Gtk2::Scrollbar) and the possible settings are
similar.
"continuous"-
value-changed is emitted on every motion event.
"delayed"-
value-changed is emitted 250 milliseconds after a change.
"discontinuous"-
value-changed is not emitted at all during the drag, only at the end
(button release or stop function).
- secret default policy
-
value-changed is emitted after a sync with the server (implemented
without blocking, see Gtk2::Ex::SyncCall) followed by reaching idle in
the main loop, or at a 250 ms timeout if idle is not reached.
This is designed to be a compromise between smoothness and excessive
drawing. The sync avoids hammering the server, then the idle waits to avoid
excessive work on the client side, but with the timeout cutting it short to
guarantee updates are not deferred indefinitely.
Choosing a policy is a matter of how good the drawing in your target widget
is. You can see the difference in the example programs included in the
sources which draw a big block of text in a Gtk2::TextView versus a
Viewport plus Gtk2::Label. The TextView goes very close to coping with
continuous update policy, but the same on the Label's simple-minded
drawing floods the server to the point of being unusable.
Dragger recognises pointer-motion-hint-mask on the target widget (or
rather the motion event is_hint) and knows to do a
$widget->get_pointer for current position and further events. That's
a deliberate server round-trip on each move, with the effect that each
motion waits until the drawing etc from the previous one has finished.
Generally you can set update_policy to continuous in this case. Give
it a try if you're having trouble with excessive drawing or excessive
network traffic with full motion events. For the drawing, the Dragger
default update_policy is meant to achieve the same effect asynchronously.
It's a bit unfortunate that an update policy is part of a controller like a
scrollbar or dragger. It'd be better if redraw frequency were left to the
widgets which are actually redrawing; or at least to an adaptor like a
Viewport for those without their own understanding.
OTHER NOTES
Some good choices for the cursor while dragging are
fleur 4-way arrow
double-arrow horizontal 2-way
sb-h-double-arrow horizontal 2-way
sb-v-double-arrow vertical 2-way
There's not much in the standard cursors for a grasping hand so you probably
have to make something like that from a pixmap.
Currently only a weak reference is kept to the target widget, so the fact
there's a dragger feature doesn't keep it alive forever. This means in
particular it's safe to hold the dragger object in the widget instance data
without creating a circular reference. But strong references are kept to
the adjustment objects since they probably should stay alive as long as the
widget and dragger do. But perhaps this will change.
Having the button-motion-mask and button-release-mask set before the
drag won't normally cost very many extra events.
A missed release event can't be properly handled after the fact.
A get_pointer can say whether the button is now down, but it may be the
user pressing elsewhere, and the x,y position of the drag release has been
completely lost. That final release position is quite important. If the
application is lagged you still want press/drag/release to move the widget
contents by the corresponding distance. It's wrong and quite annoying if
the contents jump to where the mouse has gone after release. The scrollbars
in some versions of mozilla for instance do that wrongly.
It'd be possible for the dragger to turn on button-motion-mask when
starting the drag, if not already on, using an active grab and a
$display->get_pointer to check for any missed movement. But for now
that doesn't seem worthwhile, not while the release mask can't be similarly
adapted.
BUILDABLE
Gtk2::Ex::Dragger can be built in a Gtk2::Builder spec the same as any
other Glib::Object. The class name is "Gtk2__Ex__Dragger" as usual for
Perl-Gtk package name to class name conversion. The target widget,
hadjustment and vadjustment properties can be set to objects created
in the spec, for example
<object class="Gtk2__Ex__Dragger" id="dragger">
<property name="widget">viewport</property>
<property name="hadjustment">hadjustment</property>
<property name="vadjustment">vadjustment</property>
</object>
See examples/builder.pl in the Gtk2-Ex-Dragger sources for a complete
program. Or examples/builder-internal.pl shows how to connect up to
adjustment objects offered as "internal children" of a widget (which is a
handy way to expose what a widget creates, though no Gtk core widgets do
it).
SEE ALSO
Gtk2::Adjustment, Gtk2::Ex::WidgetCursor, Gtk2::Viewport,
Gtk2::ScrolledWindow
HOME PAGE
LICENSE
Copyright 2007, 2008, 2009, 2010, 2011 Kevin Ryde
Gtk2-Ex-Dragger 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, or (at your option) any later
version.
Gtk2-Ex-Dragger 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
Gtk2-Ex-Dragger. If not, see http://www.gnu.org/licenses/.
# Copyright 2007, 2008, 2009, 2010, 2011 Kevin Ryde
# This file is part of Gtk2-Ex-Dragger.
#
# Gtk2-Ex-Dragger 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, or (at your option) any later
# version.
#
# Gtk2-Ex-Dragger 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 Gtk2-Ex-Dragger. If not, see <http://www.gnu.org/licenses/>.
package Gtk2::Ex::Dragger;
use 5.008;
use strict;
use warnings;
use Carp;
use POSIX ();
use Glib 1.220; # 1.220 for Glib::SOURCE_REMOVE
use Gtk2 1.220; # 1.220 for Gtk2::EVENT_PROPAGATE
use List::Util qw(min max);
use Scalar::Util;
use Glib::Ex::SignalIds;
use Gtk2::Ex::WidgetEvents;
# uncomment this to run the ### lines
#use Smart::Comments;
our $VERSION = 10;
use constant DELAY_MILLISECONDS => 250;
BEGIN {
Glib::Type->register_enum ('Gtk2::Ex::Dragger::UpdatePolicy',
'default',
'continuous',
'delayed',
'discontinuous',
);
}
use Glib::Object::Subclass
'Glib::Object',
properties => [ Glib::ParamSpec->object
('widget',
'Target widget',
'The target widget whose contents are to be moved around. (For a widget inside a Gtk2::ViewPort this property should be the ViewPort.)',
'Gtk2::Widget',
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->object
('hadjustment',
(do {
my $str = 'Horizontal adjustment';
# translation if available
eval { require Locale::Messages;
Locale::Messages::dgettext('gtk20-properties',$str)
} || $str }),
'Horizontal adjustment to change, or undef for no horizontal drag.',
'Gtk2::Adjustment',
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->object
('vadjustment',
(do {
my $str = 'Vertical adjustment';
# translation if available
eval { require Locale::Messages;
Locale::Messages::dgettext('gtk20-properties',$str)
} || $str }),
'Vertical adjustment to change, or undef for no vertical drag.',
'Gtk2::Adjustment',
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->boolean
('hinverted',
'Horizontal inverted',
'Whether to invert horizontal movement, for hadjustment valuess increasing to the left (ie. decreasing X coordinate).',
0, # default no
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->boolean
('vinverted',
'Vertical inverted',
'Whether to invert vertical movement, for vadjustment values increasing up the screen (ie. decreasing Y coordinate).',
0, # default no
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->boolean
('confine',
'Confine pointer',
'Confine the mouse pointer to the draggable extent per upper/lower range of the adjustments.',
0, # default no
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->enum
('update-policy',
'Update policy',
'How often to update the hadjustment and vadjustment objects for drag movement.',
'Gtk2::Ex::Dragger::UpdatePolicy',
'default',
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->scalar
('cursor',
'Cursor',
'Cursor to show while dragging, as any name or object accepted by Gtk2::Ex::WidgetCursor.',
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->string
('cursor-name',
'Cursor name',
'Cursor to show while dragging, as cursor type enum nick, or "invisible".',
(eval {Glib->VERSION(1.240);1}
? undef # default
: ''), # no undef/NULL before Perl-Glib 1.240
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->boxed
('cursor-object',
'Cursor object',
'Cursor to show while dragging, as cursor object.',
'Gtk2::Gdk::Cursor',
Glib::G_PARAM_READWRITE),
];
sub INIT_INSTANCE {
my ($self) = @_;
$self->{'h'} = {};
$self->{'v'} = {};
}
sub FINALIZE_INSTANCE {
my ($self) = @_;
$self->stop;
}
sub GET_PROPERTY {
my ($self, $pspec) = @_;
my $pname = $pspec->get_name;
### Dragger GET_PROPERTY(): $pname
if ($pname eq 'cursor_name') {
my $cursor = $self->{'cursor'};
if (Scalar::Util::blessed($cursor)) {
$cursor = $cursor->type;
# think prefer undef over cursor-is-pixmap for the get()
if ($cursor eq 'cursor-is-pixmap') {
undef $cursor;
}
}
return $cursor;
}
if ($pname eq 'cursor_object') {
my $cursor = $self->{'cursor'};
return (Scalar::Util::blessed($cursor)
&& $cursor->isa('Gtk2::Gdk::Cursor')
&& $cursor);
}
return $self->{$pname};
}
sub SET_PROPERTY {
my ($self, $pspec, $newval) = @_;
### Dragger SET_PROPERTY(): $pspec->get_name
my $pname = $pspec->get_name;
my $pname_is_cursor = ($pname =~ s/^(cursor).*/$1/);
my $oldval = $self->{$pname};
$self->{$pname} = $newval;
if ($pname_is_cursor) {
# copy boxed GdkCursor in case the caller frees it, and in particular
# for $pname eq 'cursor_object' it might be freed immediately by the
# GValue call-out stuff
# if (blessed($newval) && $newval->isa('Gtk2::Gdk::Cursor')) {
# $self->{$pname} = $newval->copy;
# }
_widget_cursor($self);
$self->notify('cursor');
$self->notify('cursor-name');
$self->notify('cursor-object');
} elsif ($pname eq 'widget') {
my $widget = $newval;
if (! $newval
|| ($oldval && $newval != $oldval)) {
# ENHANCE-ME: might be able to switch to an active grab on the new
# widget and continue
$self->stop;
}
if ($widget) {
Scalar::Util::weaken ($self->{'widget'});
}
$self->{'wevents'} = $widget && Gtk2::Ex::WidgetEvents->new
($widget, ['button-press-mask',
'button-motion-mask',
'button-release-mask']);
_widget_signals($self);
} elsif ($pname =~ /([hv])(adjustment|inverted)/) {
my $axis = $self->{$1};
my $field = $2;
$axis->{$field} = $newval;
if ($field eq 'adjustment') {
$axis->{'last_value'} = $newval && $newval->value;
_axis_signals($self,$axis);
_do_adjustment_changed ($newval, \$self);
}
} elsif ($pname eq 'confine') {
_resize_confine_win ($self);
}
}
# create or update WidgetCursor according to $self->{'cursor'}
# doesn't load WidgetCursor until drag active
sub _widget_cursor {
my ($self) = @_;
$self->{'wcursor'} = ($self->{'active'}
&& $self->{'cursor'}
&& do {
require Gtk2::Ex::WidgetCursor;
Gtk2::Ex::WidgetCursor->new
(widget => $self->{'widget'},
cursor => $self->{'cursor'},
active => 1);
});
}
# update $self->{'h'}->{'adjustment_ids'} or $self->{'v'}->... signal handlers
# handlers only applied while 'active'
sub _axis_signals {
my ($self, $axis) = @_;
my $adj;
$axis->{'adjustment_ids'} =
($self->{'active'}
&& ($adj = $axis->{'adjustment'})
&& do {
my $ref_weak_self = _ref_weak ($self);
### _axis_signals() connect
Glib::Ex::SignalIds->new
($adj,
$adj->signal_connect (changed => \&_do_adjustment_changed,
$ref_weak_self),
$adj->signal_connect (value_changed => \&_do_adjustment_value_changed,
$ref_weak_self))
});
}
# make signal handler connections on $self->{'widget'} if active
sub _widget_signals {
my ($self) = @_;
my $widget;
$self->{'widget_ids'} =
($self->{'active'}
&& ($widget = $self->{'widget'})
&& do {
my $ref_weak_self = _ref_weak ($self);
### _widget_signals() connect
Glib::Ex::SignalIds->new
($widget,
$widget->signal_connect (motion_notify_event => \&_do_motion_notify,
$ref_weak_self),
$widget->signal_connect (button_release_event => \&_do_button_release,
$ref_weak_self),
$widget->signal_connect (configure_event => \&_do_configure_event,
$ref_weak_self),
$widget->signal_connect (grab_broken_event => \&_do_grab_broken,
$ref_weak_self))
});
}
sub start {
my ($self, $event) = @_;
### Dragger start()
# maybe a second start() call could transition to a different button, but
# for now disallow it
if ($self->{'active'}) {
croak __PACKAGE__.'->start(): drag already active';
}
(Scalar::Util::blessed($event) && $event->isa('Gtk2::Gdk::Event::Button'))
or croak __PACKAGE__.'->start(): must have button press event';
my $widget = $self->{'widget'};
my $win = $widget->Gtk2_Ex_Dragger_window
or croak __PACKAGE__.'->start(): widget not realized';
$self->{'active'} = 1;
_widget_cursor($self);
_widget_signals($self);
foreach my $axis ($self->{'h'}, $self->{'v'}) {
my $adj = $axis->{'adjustment'} or next;
$axis->{'unapplied'} = 0;
$axis->{'pending'} = 0;
$axis->{'last_value'} = $adj->value;
_axis_signals ($self, $axis);
}
$self->{'button'} = $event->button;
($self->{'h'}->{'last_pixel'}, $self->{'v'}->{'last_pixel'})
= $event->get_root_coords;
if ($self->{'confine'}) {
my $confine_win = ($self->{'confine_win'} ||= Gtk2::Gdk::Window->new
($widget->get_root_window,
{ window_type => 'temp',
wclass => 'GDK_INPUT_ONLY',
override_redirect => 1 }));
### confine_win: "$confine_win"
_resize_confine_win ($self);
$confine_win->show;
# ENHANCE-ME: $win->get_events is a server round-trip, maybe fetch only
# the first time, or fetch once and then mask in the widget 'events'
# property subsequently; or something cooperating with WidgetEvents ...
#
### widget events: $widget->get_events.''
### window events: $widget->window->get_events.''
my $event_mask
= ($win->get_events & ['button-press-mask',
'pointer-motion-hint-mask',
'structure-mask',
'property-change-mask' ])
+ ['button-motion-mask', 'button-release-mask'];
### events: "$event_mask"
### grab to : $widget->window.''
### cf button press on: $event->window.''
### cf size win : "$win"
my $status = Gtk2::Gdk->pointer_grab ($widget->window,
0, # owner events
$event_mask,
$confine_win,
undef, # cursor inherited
$event->time);
### grab: "$status time ".$event->time
if ($status eq 'success') {
$self->{'grabbed'} = 1;
} else {
carp __PACKAGE__."->start(): cannot grab: $status";
}
}
}
# 'grab-broken-event' signal on the target widget
#
# This event is a client-side invention of gdk, we listen to it to know when
# gdk's grab tracking says we lost the grab due to a window unmap or another
# grab by a different part of the program. This (almost certainly) means we
# should stop dragging.
#
# Gtk2::Gdk->pointer_grab() above will itself enqueue a grab broken event if
# the $widget->window we supply there is different from the one the implicit
# grab of the button press was in. That can happen when there's multiple
# GdkWindows within $widget, with all of their events dispatched to $widget.
# For example if you put a no-window child into a Gtk2::Viewport then a
# button press on it goes to the "view_window" sub-window of the Viewport,
# which is the large moving subwindow of $widget->window (in fact
# sub-sub-window, since there's a "bin_window" in between too).
#
# The code here checks if $event->window is our pointer_grab()
# $widget->window losing the grab. (A pointer_grab() call asking for the
# same window as currently holding the grab doesn't produce a grab broken
# event, so that test is safe against a button press and grab to the same
# child window.)
#
# It'd also be possible to look at $event->grab_window to see who has the
# current grab window, to see if it's our desired $widget->window. That'd
# be a kind of more positive test, but $event->grab_window is not wrapped
# until Gtk2-Perl 1.190.
#
sub _do_grab_broken {
my ($widget, $event, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return Gtk2::EVENT_PROPAGATE;
### Dragger _do_grab_broken()
### event window : $event->window.''
### widget window: $widget->window.''
if ($self->{'grabbed'} && $event->window == $widget->window) {
$self->{'grabbed'} = 0;
$self->stop ($event);
}
return Gtk2::EVENT_PROPAGATE;
}
# 'button-release-event' signal on the target widget
sub _do_button_release {
my ($widget, $event, $ref_weak_self) = @_;
### Dragger _do_button_release()
my $self = $$ref_weak_self || return Gtk2::EVENT_PROPAGATE;
if ($event->button == $self->{'button'}) {
_do_motion_notify ($widget, $event, \$self); # final position
$self->stop ($event);
}
return Gtk2::EVENT_PROPAGATE;
}
sub stop {
my ($self, $event) = @_;
### Dragger stop()
if (! delete $self->{'active'}) { return; }
if (delete $self->{'grabbed'}) {
Gtk2::Gdk->pointer_ungrab (defined $event
? $event->time : Gtk2::GDK_CURRENT_TIME);
}
if (my $confine_win = $self->{'confine_win'}) {
$confine_win->hide;
}
if (my $id = delete $self->{'idle_id'}) {
Glib::Source->remove ($id);
}
if (my $id = delete $self->{'timer_id'}) {
Glib::Source->remove ($id);
}
delete $self->{'widget_ids'};
delete $self->{'wcursor'};
delete $self->{'h'}->{'adjustment_ids'};
delete $self->{'v'}->{'adjustment_ids'};
_emit_pending ($self);
}
# 'configure-event' signal on the target widget
sub _do_configure_event {
my ($widget, $event, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return Gtk2::EVENT_PROPAGATE;
# new window size changes the scale factor and hence how many pixels to
# the adjustable limits
_resize_confine_win ($self);
return Gtk2::EVENT_PROPAGATE;
}
# 'changed' signal on either hadjustment or vadjustment
sub _do_adjustment_changed {
my ($adj, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return;
### Dragger _do_adjustment_changed(): "$adj"
# new page size changes the scale factor and hence how many pixels to the
# adjustable limits
_resize_confine_win ($self);
}
# 'value-changed' signal on either hadjustment or vadjustment
#
# If the value we see is what we set then no action. If it's something
# different then it's a change made by the keyboard or something else
# external.
#
# We must reset any 'unapplied' amount because we can't have a non-zero
# unapplied when the value is somewhere not at the upper or lower limits,
# because unapplied is essentially how far beyond those limits the mouse is.
# (The effect of leaving an 'unapplied' is for the value to jump down or up
# unnaturally on the next drag update.)
#
sub _do_adjustment_value_changed {
my ($adj, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return;
my $axis = ($adj == ($self->{'h'}->{'adjustment'} || 0)
? $self->{'h'}
: $self->{'v'});
if ($adj->value == $axis->{'last_value'}) { return; }
### Dragger value changed externally to: $adj->value
$axis->{'last_value'} = $axis->{'adjustment'}->value;
$axis->{'unapplied'} = 0;
# new positions for the limits relative to the mouse position
_resize_confine_win ($self);
}
sub _resize_confine_win {
my ($self) = @_;
my $confine_win = $self->{'confine_win'} || return;
my $widget = $self->{'widget'};
my $win = $widget->Gtk2_Ex_Dragger_window;
my ($win_width, $win_height) = $win->get_size;
my $root = $widget->get_root_window;
my ($root_width, $root_height) = $root->get_size;
# default full root window, no confine
my $confine_x = 0;
my $confine_y = 0;
my $confine_width = $root_width;
my $confine_height = $root_height;
# The x position is so a move that far to the left would hit the limit of
# the adjustment. For normal direction a mouse move to the left increases
# adjustment value, so look at how far "value" is from "upper - page".
# For inverted a move to the left decreases adjustment value, so look at
# how far "value" is from "lower".
#
if (my $hadj = $self->{'h'}->{'adjustment'}) {
if (my $page_size = $hadj->page_size) {
$confine_x = $self->{'h'}->{'last_pixel'} -
($win_width / $page_size)
* ($self->{'h'}->{'inverted'}
? $hadj->value - $hadj->lower
: $hadj->upper - $hadj->page_size - $hadj->value);
$confine_width = $win_width
* ($hadj->upper - $hadj->lower - $hadj->page_size) / $hadj->page_size;
}
}
if (my $vadj = $self->{'v'}->{'adjustment'}) {
if (my $page_size = $vadj->page_size) {
$confine_y = $self->{'v'}->{'last_pixel'} -
($win_height / $page_size)
* ($self->{'v'}->{'inverted'}
? $vadj->value - $vadj->lower
: $vadj->upper - $vadj->page_size - $vadj->value);
$confine_height = $win_height
* ($vadj->upper - $vadj->lower - $vadj->page_size) / $vadj->page_size;
}
}
# round x,y down to integers, increasing width,height by what's subtracted
{
my $frac;
($confine_x, $frac) = _floor_and_frac ($confine_x);
$confine_width += $frac;
($confine_y, $frac) = _floor_and_frac ($confine_y);
$confine_height += $frac;
}
# round up width,height to integers
$confine_width = POSIX::ceil ($confine_width);
$confine_height = POSIX::ceil ($confine_height);
# allow an extra pixel left,right,top and bottom just in case the rounding
# is a bit off, or whatever
$confine_x--;
$confine_y--;
$confine_width += 2;
$confine_height += 2;
# Bring any negative top-left X,Y into range of the screen. This is in
# case X,Y are big negatives that overflow the signed 16-bit value in the
# X protocol.
if ($confine_x < 0) {
$confine_width += $confine_x; # reduce width accordingly
$confine_x = 0;
}
if ($confine_y < 0) {
$confine_height += $confine_y; # reduce height accordingly
$confine_y = 0;
}
# If the X,Y position is off the right or bottom of the screen then go to
# a single pixel at that right or bottom. Suspect this shouldn't occur,
# because the confine window will contain the current mouse position, and
# that's certainly somewhere on-screen.
#
if ($confine_x >= $root_width) {
$confine_x = $root_width - 1;
$confine_width = 1;
}
if ($confine_y >= $root_height) {
$confine_y = $root_height - 1;
$confine_height = 1;
}
# Chop off any width/height exceeding the screen. This is in case
# width,height are big values which overflow the 16-bit integers in the X
# protocol.
$confine_width = min ($confine_width, $root_width - $confine_x);
$confine_height = min ($confine_height, $root_height - $confine_y);
### confine to: "$confine_x,$confine_y ${confine_width}x${confine_height}"
$confine_win->move_resize ($confine_x, $confine_y,
$confine_width, $confine_height);
}
# 'motion-notify-event' on widget, and also called for button release.
#
# The basic operation is simply to look at how many pixels the new x,y in
# $event has moved from our last_x,last_y and apply those amounts to the
# "value" in the adjustments. But with attention to the following:
#
# * Scale factor $value_per_pixel converts between a window worth of pixels
# equivalent to a page size amount in the adjust.
#
# * last_x and last_y are kept in root window coordinates. This makes no
# difference to each "delta" calculated, but means we're safe against any
# changes to the widget window position; and also makes the confine_win
# calculation a little easier.
#
# * The hinverted/vinverted settings are tricky to get the right way around.
# In normal state a move to the right reduces the value, and when inverted
# it's the other way around.
#
# * An "unapplied" amount of value is maintained horizontally and vertically
# if the prospective value would be outside the adjustment upper/lower
# bounds. It gets added back each time, with the effect of keeping the
# same widget contents position under the mouse if you go beyond the limit
# and then come back.
#
sub _do_motion_notify {
my ($widget, $event, $ref_weak_self) = @_;
#### Dragger _do_motion_notify()
my $self = $$ref_weak_self || return Gtk2::EVENT_PROPAGATE;
# Believe no need for Gtk 2.12 $event->request_motions here since our
# device is only ever the mouse, so $win->get_pointer is enough. Besides,
# request_motions() looks pretty slack -- surely if you're going to do a
# server round trip (as $disp->get_pointer or $device->get_state) then you
# should use the position obtained, not throw it away.
#
# test can('is_hint') to allow for final $event a Gtk2::Gdk::Event::Button
# release; such an event doesn't have an is_hint field.
#
my ($x, $y);
if ($event->can('is_hint') && $event->is_hint) {
(undef, $x, $y) = $widget->get_root_window->get_pointer;
} else {
($x, $y) = $event->get_root_coords;
}
my $win = $widget->Gtk2_Ex_Dragger_window;
my ($win_width, $win_height) = $win->get_size;
_set_value ($self, $self->{'h'}, $win_width, $x);
_set_value ($self, $self->{'v'}, $win_height, $y);
return Gtk2::EVENT_PROPAGATE;
}
sub _set_value {
my ($self, $axis, $win_size, $pixel) = @_;
##### Dragger _set_value(): "pixel $pixel", $axis
my $adj = $axis->{'adjustment'} || return;
my $delta_pixel = $pixel - $axis->{'last_pixel'};
if ($delta_pixel == 0) { return; }
$axis->{'last_pixel'} = $pixel;
if ($axis->{'inverted'}) { $delta_pixel = - $delta_pixel; }
my $page_size = $adj->page_size;
my $value_per_pixel = $page_size / $win_size;
my $old_value = $adj->value;
my $new_value
= $old_value + $axis->{'unapplied'} - $delta_pixel * $value_per_pixel;
my $unapplied = 0;
my $lower = $adj->lower;
if ($new_value < $lower) {
$unapplied = $new_value - $lower; # negative
$new_value = $lower;
}
my $upper = $adj->upper - $page_size;
if ($new_value > $upper) {
$unapplied = $new_value - $upper; # positive
$new_value = $upper;
}
$axis->{'unapplied'} = $unapplied;
### set value: $new_value
$adj->value ($new_value);
$new_value = $axis->{'last_value'} = $adj->value; # refetch in case rounding
### rounded from NV: $new_value
if ($old_value == $new_value) {
### unchanged, no signals
return;
}
$adj->notify ('value');
my $update_policy = $self->{'update_policy'} || 'default';
if ($update_policy eq 'continuous') {
# emit on every set
$adj->value_changed;
return;
}
$axis->{'pending'} = 1;
if ($update_policy eq 'discontinuous') {
# don't emit at all until stop
return;
}
if ($update_policy eq 'delayed') {
$self->{'timer_id'} ||= Glib::Timeout->add
(DELAY_MILLISECONDS, \&_do_timer_delayed, _ref_weak ($self));
return;
}
# default policy
require Gtk2::Ex::SyncCall;
if (! $self->{'sync_obj'} && ! $self->{'timer_id'}) {
#### Dragger SyncCall send
my $ref_weak_self = _ref_weak ($self);
$self->{'sync_obj'} = Gtk2::Ex::SyncCall->sync
($self->{'widget'}, \&_do_sync, $ref_weak_self);
$self->{'timer_id'} = Glib::Timeout->add
(DELAY_MILLISECONDS, \&_do_timer_sync, $ref_weak_self);
}
}
# timer expiry for 'delayed' policy
# emit 'value-changed' when the timer expires
#
sub _do_timer_delayed {
my ($ref_weak_self) = @_;
my $self = $$ref_weak_self || return Glib::SOURCE_REMOVE;
#### Dragger _do_timer_delayed()
$self->{'timer_id'} = 0;
_emit_pending ($self);
return Glib::SOURCE_REMOVE;
}
# sync response for 'default' policy
#
# At this point we wait for the timer or for idle, whichever comes first.
# It's possible the timer has already gone off (zeroing 'timer_id'), if
# that's the case them we emit immediately; otherwise start an idle.
#
sub _do_sync {
my ($ref_weak_self) = @_;
#### Dragger _do_sync()
my $self = $$ref_weak_self || return;
$self->{'sync_obj'} = 0;
if ($self->{'timer_id'}) {
$self->{'idle_id'} ||= Glib::Idle->add
(\&_do_idle, _ref_weak ($self), Gtk2::GDK_PRIORITY_REDRAW - 1);
} else {
_emit_pending ($self);
}
}
# timer expiry for 'default' policy
#
# If the sync response hasn't yet been received then we do nothing, instead
# wait for that. If it has been received then we can emit now, and cancel
# the idle that was running.
#
sub _do_timer_sync {
my ($ref_weak_self) = @_;
my $self = $$ref_weak_self || return Glib::SOURCE_REMOVE;
#### Dragger _do_timer_sync() with sync: "$self->{'sync_obj'}"
if (my $id = $self->{'idle_id'}) {
$self->{'idle_id'} = 0;
Glib::Source->remove ($id);
}
$self->{'timer_id'} = 0;
if (! $self->{'sync_obj'}) {
_emit_pending ($self);
}
return Glib::SOURCE_REMOVE;
}
# idle handler for 'default' policy
sub _do_idle {
my ($ref_weak_self) = @_;
#### Dragger _do_idle() after sync
my $self = $$ref_weak_self || return Glib::SOURCE_REMOVE;
if (my $id = $self->{'timer_id'}) {
$self->{'timer_id'} = 0;
Glib::Source->remove ($id);
}
$self->{'idle_id'} = 0;
_emit_pending ($self);
return Glib::SOURCE_REMOVE;
}
sub _emit_pending {
my ($self) = @_;
foreach my $axis ($self->{'h'}, $self->{'v'}) {
if ($axis->{'pending'}) {
$axis->{'pending'} = 0;
$axis->{'adjustment'}->value_changed;
}
}
}
#------------------------------------------------------------------------------
# $widget->Gtk2_Ex_Dragger_window() returns the window in $widget which the
# dragger should operate on (the size to page conversion).
#
# Crib notes:
#
# GtkLayout, and subclasses like GnomeCanvas
# Plain $widget->window is the visible extent, so nothing special
# needed. The scrolls move the bin_window subwindow, but how scrolling
# is drawn doesn't matter to us.
#
sub Gtk2::Widget::Gtk2_Ex_Dragger_window {
my ($widget) = @_;
if (exists $widget->{'Gtk2_Ex_Dragger_window'}) {
# user override -- but this not (yet) a documented feature as such
return $widget->{'Gtk2_Ex_Dragger_window'};
}
# default
return $widget->window;
}
# for TextView the "text" window is the visible extent
sub Gtk2::TextView::Gtk2_Ex_Dragger_window {
my ($textview) = @_;
return $textview->get_window ('text');
}
# for TreeView the "bin" window is the visible extent
*Gtk2::TreeView::Gtk2_Ex_Dragger_window
= \&Gtk2::TreeView::get_bin_window;
# For Viewport there's $widget->window then within that a "view_window"
# which is smaller by the border size. This view_window is the scrollable
# part we're interested in, but it's not a documented feature, so this is a
# nasty hack to pick it out.
#
# The $viewport->get_bin_window is a sub-window of the view_window. It
# contains the viewport children. (In the gtk manual in gtk 2.20 but not
# explained as such.)
#
sub Gtk2::Viewport::Gtk2_Ex_Dragger_window {
my ($viewport) = @_;
my $win;
return (($win = $viewport->window) # if realized
&& ($win->get_children)[0]);
}
#------------------------------------------------------------------------------
# generic helpers
# Return two values ($floor, $frac).
# $floor is $x rounded down to an integer towards negative infinity
# $frac is the fractional part subtracted from $x to get to $floor,
# so $floor+$frac == $x
#
sub _floor_and_frac {
my ($x) = @_;
my $f = POSIX::floor ($x);
return ($f, $x - $f);
}
sub _ref_weak {
my ($self) = @_;
Scalar::Util::weaken ($self);
return \$self;
}
#------------------------------------------------------------------------------
1;
__END__