#! perl  
# /pl/GuiTest/monkeytest-calculator.pl

# rudif@lecroy.com 12 Dec 2001

# a demo monkey test
# morphed from Win32::GuiTest test scripts

# fire up the windows Calculator app
# then start this script from a Command Prompt window
# to interrupt the script, press Esc several times

use strict;

use Win32::GuiTest qw/
    FindWindowLike
    GetChildDepth
    GetChildWindows
    GetClassName
    GetDesktopWindow
    GetScreenRes
    GetWindowRect
    GetWindowText
    IsCheckedButton
    IsWindow
    SendKeys
    SetForegroundWindow
    WMGetText
    MouseMoveAbsPix
    SendLButtonDown
    SendLButtonUp
    GetCursorPos
    SendMouseMoveRel
    SendMouse
    /;

use ReadKeypress;


# Find App window 
my $app = "Calculator";
my @windows = FindWindowLike(0, $app);
my $appwin = $windows[0];
print "not " unless scalar @windows == 1;
printf "ok 5: %08x \n", $appwin;

# App window coordinates (pixels) on desktop
my ($left, $top, $right, $bottom) = GetWindowRect($appwin);
my ($width, $height) = ($right - $left, $bottom - $top);
printf "ok 6: appwin $left, $top, $right, $bottom, ($width, $height)\n
+", $appwin;


# Find the Command Prompt window 
my @cmds = FindWindowLike(0, "Command Prompt", "");
printf STDERR "ok 7: %08x \n", $cmds[0];
my $cmdprompt = $cmds[0];


SetForegroundWindow($appwin);
print "ok 7\n";


my ($margx, $margy) = ( 30, 40 );
my ($awleft, $awtop) = ($left+$margx, $top+$margy);
my ($awright, $awbottom) = ($right-$margx, $bottom-$margy);
my ($stepx, $stepy) = (60,40);  # approximates the Menu spacing
my ($maxposx, $maxposy) = ( int(($awright - $awleft) / $stepx), int(($
+awbottom - $awtop) / $stepy));
my ($minpixx, $minpixy) = ($awleft, $awtop);
my ($maxpixx, $maxpixy) = ($awleft + $maxposx * $stepx, $awtop + $maxp
+osy * $stepy);

my $pause1 = 1000;
MouseMoveAbsPix($minpixx, $minpixy);
SendKeys "{PAUSE $pause1}";
MouseMoveAbsPix($maxpixx, $minpixy);
SendKeys "{PAUSE $pause1}";
MouseMoveAbsPix($maxpixx, $maxpixy);
SendKeys "{PAUSE $pause1}";
MouseMoveAbsPix($minpixx, $maxpixy);
SendKeys "{PAUSE $pause1}";
MouseMoveAbsPix($minpixx, $minpixy);
SendKeys "{PAUSE $pause1}";

my $pause = 50;

print STDERR "PRESS ESCAPE SEVERAL TIMES TO QUIT\n";

print STDERR "\nrandom scan of menus\n";

my $n = 33;

for my $x (0..$n) {
    for my $y (0..4) {
        my $posx = randposx($x); # random column
        MouseMoveAbsPix $posx, posy(0); # top menu line
        SendMouse "{LEFTCLICK}";
        SendKeys "{PAUSE $pause}";
        MouseMoveAbsPix $posx, randposy($y); # down in the same column
+, random
        SendMouse "{LEFTCLICK}";
        SendKeys "{PAUSE $pause}";
        checkEscapeAndPause(50);
    }
}

print STDERR "\nlinear scan of menus\n";
for my $x (0..$maxposx) {
    for my $y (0..$maxposy) {
        MouseMoveAbsPix posx($x), posy(0); # top menu line
        SendMouse "{LEFTCLICK}";
        SendKeys "{PAUSE $pause}";
        MouseMoveAbsPix posx($x), posy($y); # down in the same column
        SendMouse "{LEFTCLICK}";
        SendKeys "{PAUSE $pause}";
        checkEscapeAndPause(50);
    }
}

print STDERR "\ndone\n";

#
# subs
#


sub randpos { 
    (randposx(), randposx());
}

sub randposx { 
    posx($maxposx * rand());
}

sub randposy { 
    posy($maxposy * rand());
}

sub posx { 
    my $posx = shift;
    ($minpixx + $stepx * $posx);
}

sub posy { 
    my $posy = shift;
    ($minpixy + $stepy * $posy);
}



sub checkEscapeAndPause {
    my $millisec = shift || 10;
#    print STDERR "checkEscapeAndPause $millisec\n";
    print STDERR ".";
    SendKeys "{PAUSE $millisec}";
    SetForegroundWindow($cmdprompt);
    SendKeys "{PAUSE 200}";
    if (ReadKeypress::escape()) {
        print STDERR "\nEscaped!\n";
        exit();
    }
    SetForegroundWindow($appwin);
}

__END__
[download]

#!perl -w

use strict;
use warnings;

package ReadKeypress;

use Term::ReadKey;
use Fcntl;

if ($^O =~ /Win32/i) {
    sysopen(IN,'CONIN$',O_RDWR) or die "Unable to open console input:$
+!";
    sysopen(OUT,'CONOUT$',O_RDWR) or die "Unable to open console outpu
+t:$!";
} else {
    open(IN,"</dev/tty");
    *OUT = *IN;
}

ReadMode 4, \*IN;

sub keypress {
    ReadKey(-1, \*IN) || '';    
}

sub escape {
    chr(27) eq keypress();
}

1;

__END__

=head1 NAME

ReadKeypress - Perl extension for nonblocking polling the keyboard.

=head1 SYNOPSIS

    use ReadKeypress;
    print "press Escape to stop\n";
    for (1..42) {
        sleep 1;
        print "$_ ";
        print "Escaped!\n" and exit if ReadKeypress::escape();
    }


=head1 DESCRIPTION

ReadKeypress defines two methods for non-blocking reading of keyboard.


=over 4

=item ReadKeypress::keypress()

Tries to read one character from keyboard and returns immediately, wit
+hout blocking. 
It returns the character read if any was available, the empty string '
+' otherwise.


=item ReadKeypress::escape()

Returns immediately, with a true value if Escape (x1B) was pressed, fa
+lse value otherwise.

=back

=head1 AUTHOR

Rudi Farkas rudif@lecroy.com

=head1 SEE ALSO

Term::ReadKey documentation.

=cut
[download]