Re: iPad bells and whistles

Here's a prototype/proof-of-concept for an ordinary screen.

I've written it in Perl/Tk and tested on Cygwin and Windows XP. It's basically a Text widget with lots of content. Moving the mouse around at (what I consider to be) normal speed does nothing; swiping the mouse horizontally, vertically or diagonally will scroll the window in the same direction.

You may need to tweak a few numbers:

The geometry ($mw->geometry('1200x900+50+50'); is widthxheight+x-offset+y-offset - see the geometry() method in Tk::Wm for details (or just comment that line out and position/resize manually).
The distance the mouse has to travel before the gesture is recognised is governed by X_MIN_DISTANCE_VARIATION and Y_MIN_DISTANCE_VARIATION - the settings I have worked for me but your mileage may vary.
The amount of scrolling is controlled by X_UNIT_SCROLL and Y_UNIT_SCROLL - again, you may want to customise these.
Recognition of whether the mouse is being moved at normal speed or being swiped is determined by MAX_TIME_VARIATION - mouse acceleration, pointer speed and similar settings you currently have in place will affect this.

Here's the code:

#!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"
        );
    }
}
[download]

Enjoy!

-- Ken

Comment on Re: iPad bells and whistles Select or Download Code

Replies are listed 'Best First'.
Re^2: iPad bells and whistles by Steve_BZ (Chaplain) on Nov 23, 2010 at 15:39 UTC
Hi Ken, Thanks very much for this idea. I just tried to run your code, as I've been using wxPerl, I needed to install Tk, but I got: C:/msys/mingw/bin/gcc.exe -c -I.. -I.. -I../pTk/mTk/xlib -I. -Ibitmap +s -I.. -I. ./pTk/mTk/xlib -DNDEBUG -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCR +YPT -DUSE_ SITECUSTOMIZE -DPRIVLIB_LAST_IN_INC -DPERL_IMPLICIT_CONTEXT -DPERL_IMP +LICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX -DHASATTRIBUTE -fno-strict-aliasing + -mms-bitf ields -DPERLDLL -O2 -DVERSION=\"804.029\" -DXS_VERSION=\ +"804.029\" "-IC:\Perl\lib\CORE" -Wall -Wno-implicit-int -Wno-comment -Wno-unu +sed -D__US E_FIXED_PROTOTYPES__ xutil.c rc -fo tk.res -r -i . -i mTk\win\rc mTk\win\rc\tk.rc 'rc' is not recognized as an internal or external command, operable program or batch file. dmake.exe: Error code 129, while making 'tk.res' dmake.exe: Error code 255, while making 'pTk\libpTk.a' SREZIC/Tk-804.029.tar.gz C:\Perl\site\bin\dmake.exe -- NOT OK Running make test Can't test without successful make Running make install Make had returned bad status, install seems impossible Failed during this command: SREZIC/Tk-804.029.tar.gz : make NO [download] I'm going to check it out, but I wanted you to know that I'm on the case. Regards Steve	[reply] [d/l]
Re^3: iPad bells and whistles by kcott (Archbishop) on Nov 24, 2010 at 00:39 UTC
Perl/Tk has had its fair share of installation problems (see the CPAN Testers Matrix). Having said that, I'm running it successfully on Windows XP and Cygwin using Perl 5.12.0 on both; although, I probably needed to do a manual install in both cases. I'm using Strawberry Perl for MSWindows; I believe ActivePerl provides Tk as part of their default distribution. If you get past the `make` stage and `make test` fails, try jumping straight to `make install` - others on this site have said that works for them. I aimed to keep newer Perl features out of the prototype code so, while I developed it using 5.12.0, I don't think there's anything that isn't available on 5.8.x versions. Of course, rather than messing around with Tk, you may decide to just port the code to wxPerl. Most of the code is fairly standard Perl much of which I imagine you could retain as is; the GUI-specific parts are: A main (top-level) window for the application (with geometry described above): `my $mw = MainWindow->new(-title => 'Mouse Gesture Test'); $mw->geometry('1200x900+50+50');` [download] A Text widget for testing (although any widget with scrolling capabilities should work) - adding scrollbars is a handy visual aid when developing: `my $w_text = $mw->Scrolled('Text', -scrollbars => 'osoe', -wrap => 'none', )->pack(-fill => 'both', -expand => 1);` [download] An event handler to call when mouse movement occurs: `$w_text->bind('<Motion>', [\&mouse_gesture, Ev('x'), Ev('y')]);` [download] An Exit button: `$mw->Button(-text => q{Exit}, -command => sub { exit })->pack();` [download] A means of scrolling the widget programmatically: `$w->xviewScroll($xpos < $x ? 1 : -1, q{units}); ... $w->yviewScroll($ypos < $y ? 1 : -1, q{units});` [download] Enough content in the widget so there's something to actually scroll - here I'm adding 500 lines each with a little over 500 characters: `$w->insert('end', "This is line $_. It's really long ... $long_string\n" );` [download] -- Ken	[reply] [d/l] [select]
Re^2: iPad bells and whistles by Steve_BZ (Chaplain) on Nov 27, 2010 at 01:08 UTC
Hi Ken, Well I managed to install Tk using PPM as you suggested, so that went well. The code worked first time, so that was good to see. I'm off to the states next month (I live in Brazil), so I thought I'd try to buy a cheap touch screen monitor while I was there. I get back in Jan, so I'll try and play around with this code more when I get the screen and I'll post some snippets. Thanks for the taster. Regards Steve	[reply]
Re^3: iPad bells and whistles by kcott (Archbishop) on Nov 27, 2010 at 01:38 UTC
Good to hear you got the Tk installation problems sorted out and encountered no problems while running the code. I'll look forward to an update next year. -- Ken	[reply]