http://www.perlmonks.org?node_id=928371

If you've ever wanted to see how fast a remote controlled car can actually go (or you are bored and want to see how fast you can spin your mouse wheel) this script is for you.

This script measures how fast the mouse wheel is spinning and translates that into miles per hour (when I'm bored I write stuff in perl).

Note: The script is calibrated for a Microsoft Wireless IntelliMouse Explorer 2.0

use warnings; use strict; use Tk ':variables'; use Time::HiRes; my $clicksPerRevolution = 17; #how many numbers are sampled in one com +plete revolution of the mouse wheel my $wheelArea = 4.75; #how many inches are in one complete revolution +of the mouse wheel my $clicksPerMile = (63360/$wheelArea)*$clicksPerRevolution; #63360 in +ches in a mile my $mouseWheel = 0; my ($previousClickTime, $currentClickTime); my $maxSpeed = 0; my $mw = MainWindow->new(); my $lbl1 = $mw->Label(-text => 'Max MPH'); my $lbl2 = $mw->Label(-textvariable => \$maxSpeed); my $lbl3 = $mw->Label(-text => 'Current MPH'); my $lbl4 = $mw->Label(-textvariable => \$mouseWheel); $lbl1->grid(-row => '0', -column => '0'); $lbl2->grid(-row => '0', -column => '1'); $lbl3->grid(-row => '1', -column => '0'); $lbl4->grid(-row => '1', -column => '1'); $mw->bind('<MouseWheel>' => \&mph ); $mw->bind('<4>' => \&mph ); #zentara $mw->bind('<5>' => \&mph ); #zentara $mw->MainLoop(); sub mph{ $previousClickTime = $currentClickTime; $mouseWheel = $Tk::event->XEvent; $incr++; ($seconds, $microseconds) = Time::HiRes::gettimeofday(); $currentClickTime = $microseconds; if ($incr > $clicksPerRevolution){ $incr = 1; } $microSecondsBetweenClicks = $currentClickTime-$previousClickTime; if (eval{ $mouseWheel = sprintf '%.2f', (1/$clicksPerMile)/($micro +SecondsBetweenClicks/3600000000); }){} if ($mouseWheel > $maxSpeed && $mouseWheel < 600){ $maxSpeed = $mouseWheel; } } sub arrPush{ my $value = shift; push (@avgArray, $value); }

Replies are listed 'Best First'.
Re: Use your mouse wheel as a dynamometer
by zentara (Archbishop) on Sep 28, 2011 at 17:21 UTC
    Dosn't work on linux, $mw->bind('<MouseWheel>' => \&mph ); dosn't connect.

    I added

    $mw->bind('<MouseWheel>' => \&mph ); # for linux to work add $mw->bind('<4>' => \&mph ); $mw->bind('<5>' => \&mph );
    You should also use warnings; and use strict;

    You might find Simple Tk Gauge interesting.


    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
      I do use warnings and strict, but once I have no errors i like to remove them to reduce memory. I added your comments to the original code.
        I do use warnings and strict, but once I have no errors i like to remove them to reduce memory.

        Picky Hat on:

        I don't see how you could have used warnings and strict during development of this script, as you have too many variables with undeclared scope, as seen when you put warnings and strict back in. Unless you tell me you removed all the "my" declarations, to save memory, I just don't believe your assertion.

        So now that you added warnings and strict to your code block, it throws errors in the sub mph{} and sub arrPush{}. Maybe you ought to take warnings and strict out? :-) heh heh heh

        In that train of thought, what memory savings do you get by removing them? The millisecond you gain at program startup is far overwhelmed by the problems you have in your variables.

        Sorry to be picky about this, but sloppy code is harder to troubleshoot, which I needed to do to get the binding working for linux.


        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh
Re: Use your mouse wheel as a dynamometer
by ssandv (Hermit) on Sep 29, 2011 at 22:27 UTC

    Super-duper-picky comment:

    A dynamometer measures torque, by measuring braking or stopping force. A tachometer measures RPM. A speedometer measures linear speed.

    This is not a dynamometer.

Re: Use your mouse wheel as a dynamometer
by Discipulus (Canon) on Sep 29, 2011 at 08:26 UTC

    incredible! how many things perl can do!! what a pity for inch miles system: I have some allergy to it i think. ++ for you!
    there are no rules, there are no thumbs..
Re: Use your mouse wheel as a dynamometer
by hominid (Priest) on Sep 28, 2011 at 17:26 UTC
    Nice. What's the world record for mouse wheel speed?
Re: Use your mouse wheel as a dynamometer
by PhilipJ (Initiate) on Oct 20, 2011 at 17:01 UTC

    This is a pretty fantastic program! ++