"Bouncing" panning canvas

classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

"Bouncing" panning canvas

Gtk+ - Perl mailing list
I've subclassed Goo::Canvas2 to add panning and zooming via the mouse.
It works well, apart from the fact that panning tends to "bounce" if the
the user tries to pan too fast.

I use Goo::Canvas to display OCR output and use exactly the same code to
pan a DrawingArea with a pixbuf of the image from which the OCR output
came from. The DrawingArea pans smoothly.

Does anyone have any insight what might be going on?

The code is below. Stored as canvas.pl, you can run it with

perl canvas.pl

Pan with the left mouse button. Zoom with the mouse wheel.

package My::Canvas;

use strict;
use warnings;
use feature 'switch';
no if $] >= 5.018, warnings => 'experimental::smartmatch';
use Gtk3;
use GooCanvas2;
use Glib 1.220 qw(TRUE FALSE);    # To get TRUE and FALSE

use Glib::Object::Subclass GooCanvas2::Canvas::, signals => {
    'zoom-changed' => {
        param_types => ['Glib::Float'],    # new zoom
    },
    'offset-changed' => {
        param_types => [ 'Glib::Int', 'Glib::Int' ],    # new offset
    },
  },
  properties => [
    Glib::ParamSpec->scalar(
        'offset',                                       # name
        'Image offset',                                 # nick
        'Gdk::Rectangle hash of x, y',                  # blurb
        [qw/readable writable/]                         # flags
    ),
  ];

sub INIT_INSTANCE {
    my $self = shift;

    # Set up the canvas
    $self->signal_connect( 'button-press-event'   => \&_button_pressed );
    $self->signal_connect( 'button-release-event' => \&_button_released );
    $self->signal_connect( 'motion-notify-event'  => \&_motion );
    $self->signal_connect( 'scroll-event'         => \&_scroll );
    if (
        $Glib::Object::Introspection::VERSION <
        0.043    ## no critic (ProhibitMagicNumbers)
      )
    {
        $self->add_events(
#            ${ Gtk3::Gdk::EventMask->new(qw/exposure-mask/) } |
              ${ Gtk3::Gdk::EventMask->new(qw/button-press-mask/) } |
              ${ Gtk3::Gdk::EventMask->new(qw/button-release-mask/) } |
              ${ Gtk3::Gdk::EventMask->new(qw/pointer-motion-mask/) } |
              ${ Gtk3::Gdk::EventMask->new(qw/scroll-mask/) } );
    }
    else {
        $self->add_events(
#            Glib::Object::Introspection->convert_sv_to_flags(
#                'Gtk3::Gdk::EventMask', 'exposure-mask' ) |
              Glib::Object::Introspection->convert_sv_to_flags(
                'Gtk3::Gdk::EventMask', 'button-press-mask' ) |
              Glib::Object::Introspection->convert_sv_to_flags(
                'Gtk3::Gdk::EventMask', 'button-release-mask' ) |
              Glib::Object::Introspection->convert_sv_to_flags(
                'Gtk3::Gdk::EventMask', 'pointer-motion-mask' ) |
              Glib::Object::Introspection->convert_sv_to_flags(
                'Gtk3::Gdk::EventMask', 'scroll-mask'
              )
        );
    }
    $self->{offset}{x} = 0;
    $self->{offset}{y} = 0;
#    $self->set_double_buffered(FALSE);
    return $self;
}

sub SET_PROPERTY {
    my ( $self, $pspec, $newval ) = @_;
    my $name   = $pspec->get_name;
    my $oldval = $self->get($name);
    if (   ( defined $newval and defined $oldval and $newval ne $oldval )
        or ( defined $newval xor defined $oldval ) )
    {
        given ($name) {
            when ('offset') {
                if (   ( defined $newval xor defined $oldval )
                    or $oldval->{x} != $newval->{x}
                    or $oldval->{y} != $newval->{y} )
                {
                    $self->{$name} = $newval;
                    $self->scroll_to( -$newval->{x}, -$newval->{y} );
#                    print "canvas emitting offset-changed $newval->{x},
$newval->{y}\n";
                    $self->signal_emit( 'offset-changed', $newval->{x},
                        $newval->{y} );
                }
            }
            default {
                $self->{$name} = $newval;

                #                $self->SUPER::SET_PROPERTY( $pspec,
$newval );
            }
        }
    }
    return;
}

sub get_pixbuf_size {
    my ( $self ) = @_;
    return $self->{pixbuf_size};
}

sub set_offset {
    my ( $self, $offset_x, $offset_y ) = @_;
    if ( not defined $self->get_pixbuf_size ) { return }
#    print "in canvas set_offset( $offset_x, $offset_y )\n";

    # Convert the widget size to image scale to make the comparisons easier
    my $allocation = $self->get_allocation;
    ( $allocation->{width}, $allocation->{height} ) =
      $self->_to_image_distance( $allocation->{width},
$allocation->{height} );

    my $pixbuf_size = $self->get_pixbuf_size;
    $offset_x = _clamp_direction( $offset_x, $allocation->{width},
        $pixbuf_size->{width} );
    $offset_y = _clamp_direction( $offset_y, $allocation->{height},
        $pixbuf_size->{height} );
#    print "offset after clamping $offset_x, $offset_y\n";
#    printf "bounds before centering %d, %d, %d, %d\n", $self->get_bounds;

    my $min_x = 0;
    my $min_y = 0;
    if ( $offset_x > 0 ) {
        $min_x = -$offset_x;
#        $offset_x = 0;
    }
    if ( $offset_y > 0 ) {
        $min_y = -$offset_y;
#        $offset_y = 0;
    }
    $self->set_bounds(
        $min_x, $min_y,
        $pixbuf_size->{width} - $min_x,
        $pixbuf_size->{height} - $min_y
    );
#    printf "bounds after centering %d, %d, %d, %d\n", $self->get_bounds;

    $self->set( 'offset', { x => $offset_x, y => $offset_y } );
    return;
}

sub get_offset {
    my ($self) = @_;
    return $self->get('offset');
}

# convert x, y in widget distance to image distance
sub _to_image_distance {
    my ( $self, $x, $y ) = @_;
    my $zoom = $self->get_scale;
    return $x / $zoom, $y / $zoom;
}

# set zoom with centre in image coordinates
sub _set_zoom_with_center {
    my ( $self, $zoom, $center_x, $center_y ) = @_;
    my $allocation = $self->get_allocation;
    my $offset_x   = $allocation->{width} / 2 / $zoom - $center_x;
    my $offset_y   = $allocation->{height} / 2 / $zoom - $center_y;
    $self->set_scale($zoom);
    $self->signal_emit( 'zoom-changed', $zoom );
    $self->set_offset( $offset_x, $offset_y );
    return;
}

sub _clamp_direction {
    my ( $offset, $allocation, $pixbuf_size ) = @_;

    # Centre the image if it is smaller than the widget
    if ( $allocation > $pixbuf_size ) {
        $offset = ( $allocation - $pixbuf_size ) / 2;
    }

    # Otherwise don't allow the LH/top edge of the image to be visible
    elsif ( $offset > 0 ) {
        $offset = 0;
    }

    # Otherwise don't allow the RH/bottom edge of the image to be visible
    elsif ( $offset < $allocation - $pixbuf_size ) {
        $offset = $allocation - $pixbuf_size;
    }
    return $offset;
}

sub _button_pressed {
    my ( $self, $event ) = @_;

    # left mouse button
    if ( $event->button != 1 ) { return FALSE }

    $self->{drag_start} = { x => $event->x, y => $event->y };
    $self->{dragging} = TRUE;
#    $self->update_cursor( $event->x, $event->y );
    return TRUE;
}

sub _button_released {
    my ( $self, $event ) = @_;
    $self->{dragging} = FALSE;
#    $self->update_cursor( $event->x, $event->y );
    return TRUE;
}

sub _motion {
    my ( $self, $event ) = @_;
#    $self->update_cursor( $event->x, $event->y );
    if ( not $self->{dragging} ) { return FALSE }
    printf "canvas motion %d %d -> %d %d\n", $self->{drag_start}{x},
$self->{drag_start}{y}, $event->x, $event->y;
#    printf "canvas %f %f \n", $self->convert_from_pixels($event->x,
$event->y);

    my ($delta_x, $delta_y) = $self->_to_image_distance(  $event->x -
$self->{drag_start}{x}, $event->y - $self->{drag_start}{y} );
    ( $self->{drag_start}{x}, $self->{drag_start}{y} ) =
      ( $event->x, $event->y );
    my $offset = $self->get_offset;
    $self->set_offset( $offset->{x} + $delta_x, $offset->{y} + $delta_y );
    return TRUE;
}

sub _scroll {
    my ( $self, $event ) = @_;
    my ( $center_x, $center_y ) =
      $self->convert_from_pixels( $event->x, $event->y );
    my $zoom;
    if ( $event->direction eq 'up' ) {
        $zoom = $self->get_scale * 2;
    }
    else {
        $zoom = $self->get_scale / 2;
    }
    $self->_set_zoom_with_center( $zoom, $center_x, $center_y );
    return TRUE;
}

package main;

use strict;
use warnings;
use Gtk3 -init;

my $window = Gtk3::Window->new();
$window->set_default_size(600, 600);
$window->signal_connect('destroy' => sub {Gtk3->main_quit()});

my $canvas = My::Canvas->new();
$canvas->{pixbuf_size} = { width => 600, height => 600 };

my $root = $canvas->get_root_item();

GooCanvas2::CanvasRect->new(parent => $root,
                            x => 0,
                            y => 0,
                            width => 600,
                            height => 600);
GooCanvas2::CanvasEllipse->new(parent => $root,
                            'center-x' => 300,
                            'center-y' => 300,
                            'radius-x' => 100,
                            'radius-y' => 100);
GooCanvas2::CanvasEllipse->new(parent => $root,
                            'center-x' => 300,
                            'center-y' => 300,
                            'radius-x' => 50,
                            'radius-y' => 50);
$window->add($canvas);
$window->show_all;

# Pass control to the Gtk3 main event loop
Gtk3->main();

__END__


_______________________________________________
gtk-perl-list mailing list
[hidden email]
https://mail.gnome.org/mailman/listinfo/gtk-perl-list

signature.asc (849 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: "Bouncing" panning canvas

Gtk+ - Perl mailing list
On 12/12/2018 21:42, Jeff wrote:
> I've subclassed Goo::Canvas2 to add panning and zooming via the mouse.
> It works well, apart from the fact that panning tends to "bounce" if the
> the user tries to pan too fast.

If anyone is interested, I was able to work around this problem by using
the root window coordinates, rather than those returned by the event, as
panning is only interested in the relative mouse movement since the last
event:

    my $display = Gtk3::Gdk::Display::get_default;
    my $manager = $display->get_device_manager;
    my $device = $manager->get_client_pointer;
    my ( $screen, $x, $y ) = $device->get_position;

Regards

Jeff


_______________________________________________
gtk-perl-list mailing list
[hidden email]
https://mail.gnome.org/mailman/listinfo/gtk-perl-list

signature.asc (849 bytes) Download Attachment