#!perl

use strict;
use warnings;

use Time::HiRes qw{gettimeofday tv_interval};
use Tk;

use constant {
    MAX_TIME_VARIATION => 0.01,
    X_MIN_DISTANCE_VARIATION => 25,
    Y_MIN_DISTANCE_VARIATION => 18,
    X_UNIT_SCROLL => 4,
    Y_UNIT_SCROLL => 3,
};

my $mw = MainWindow->new(-title => 'Mouse Gesture Test');
$mw->geometry('1200x900+50+50');

my $w_text = $mw->Scrolled('Text',
    -scrollbars => 'osoe',
    -wrap => 'none',
)->pack(-fill => 'both', -expand => 1);

my ($xpos, $ypos);
my $t0 = [gettimeofday];

$w_text->bind('<Motion>', [\&mouse_gesture, Ev('x'), Ev('y')]);

populate_text_widget($w_text);

$mw->Button(-text => q{Exit}, -command => sub { exit })->pack();

MainLoop;

sub mouse_gesture {
    my ($w, $x, $y) = @_;

    # Once-off initialisation
    if (! defined $xpos) {
        $xpos = $x;
        $ypos = $y;
        return;
    }

    my $t1 = [gettimeofday];

    if (tv_interval($t0, $t1) > MAX_TIME_VARIATION) {
        $t0 = $t1;
        $xpos = $x;
        $ypos = $y;
    }
    else {
        if (abs(abs($xpos) - abs($x)) > X_MIN_DISTANCE_VARIATION) {
            $t0 = $t1;
            for (1 .. X_UNIT_SCROLL) {
                $w->xviewScroll($xpos < $x ? 1 : -1, q{units});
            }
            $xpos = $x;
        }

        if (abs(abs($ypos) - abs($y)) > Y_MIN_DISTANCE_VARIATION) {
            $t0 = $t1;
            for (1 .. Y_UNIT_SCROLL) {
                $w->yviewScroll($ypos < $y ? 1 : -1, q{units});
            }
            $ypos = $y;
        }
    }

    return;
}

sub populate_text_widget {
    my $w = shift;

    my $long_string = '';
    for ('a' .. 'z') {
        $long_string .= $_ x 20;
    }

    for (1 .. 500) {
        $w->insert('end',
            "This is line $_. It's really long ... $long_string\n"
        );
    }
}