# these tests are useless in the automated build process
exit if $ENV{PERL_MM_USE_DEFAULT};
use Win32::Console;
$^W = 0; # we get about a trillion warn_undef-s
$OUT = new Win32::Console(STD_OUTPUT_HANDLE);
$IN = new Win32::Console(STD_INPUT_HANDLE);
$OUT->Title("Win32::Console version $Win32::Console::VERSION TEST SUITE");
my($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
explodeAttr($OUT, $FG_RED | $BG_YELLOW) if ($wLeft - $wRight);
# explodeAttr($OUT, $ATTR_NORMAL);
($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
showAbout() if ($wLeft - $wRight);
$OUT->Cls();
($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
Window($OUT, $FG_WHITE | $BG_BLUE, " ", $wLeft, $wTop, $wRight-$wLeft, 2);
$OUT->Cursor(3, 1);
$OUT->Write("Test About Quit");
$OUT->FillAttr($FG_BLACK | $BG_WHITE, 6, $wLeft+2, $wTop+1);
$menu=1;
@menupos = (0, $wLeft+2, $wLeft+9, $wLeft+17);
@menulen = (0, 6, 7, 6);
$OUT->FillAttr($FG_BLACK | $BG_WHITE, $menulen[$menu], $menupos[$menu], $wTop+1);
$IN->Mode(ENABLE_MOUSE_INPUT);
$string = "(Press ESC to exit)";
$OUT->Attr($FG_GRAY | $BG_BLUE);
$OUT->Cursor($wRight-$wLeft-length($string)-3, $wTop+1);
$OUT->Write($string);
# Position the cursor on the middle of the screen
# and make it visible as a full character
$mX = ($wRight - $wLeft) / 2;
$mY = ($wBottom - $wTop) / 2;
$OUT->Cursor($mX, $mY, 99, 1);
# Main loop
while ($key ne chr(27)) {
last unless ($wLeft - $wRight);
@event = $IN->Input();
$do = 0;
if ($event[0] == 1 and $event[1]) {
$key = chr($event[5]);
# ENTER
if ($event[5] == 13) {
$do = $menu;
}
# LEFT ARROW
if ($event[3] == 37
and $event[4] == 75
and $menu > 1) {
$menu = $menu - 1;
highlightMenu($menu);
}
# RIGHT ARROW
if ($event[3] == 39
and $event[4] == 77
and $menu < 3) {
$menu = $menu + 1;
highlightMenu($menu);
}
}
elsif ($event[0]==2) {
$mX = $event[1];
$mY = $event[2];
if ($event[3] == 1 and $mY == $wTop+1) {
for $m (1..3) {
if ($mX >= $menupos[$m] and $mX <= $menupos[$m]+$menulen[$m]) {
$menu = $m;
$do = $menu;
}
}
highlightMenu($menu);
}
}
if ($do == 1) {
grayMenu();
$T = chooseTest();
&$T if $T;
highlightMenu($menu);
}
elsif ($do == 2) {
($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
$cX = $wLeft + int((($wRight-$wLeft)-45)/2);
$cY = $wTop + int((($wBottom-$wTop)-8)/2);
$BACKGROUND = $OUT->ReadRect($cX, $cY, $cX+45, $cY+8);
showAbout();
$OUT->WriteRect($BACKGROUND, $cX, $cY, $cX+45, $cY+8);
}
elsif ($do==3) {
exit(0);
}
$OUT->Cursor($mX, $mY);
}
print "\n";
#=============
sub grayMenu {
#=============
my $m;
for $m (1..3) {
$OUT->FillAttr($FG_GRAY | $BG_BLUE, $menulen[$m], $menupos[$m], $wTop+1);
}
}
#==================
sub highlightMenu {
#==================
my($menu) = @_;
my $m;
for $m (1..3) {
if ($m == $menu) {
$OUT->FillAttr($FG_BLACK | $BG_WHITE, $menulen[$m], $menupos[$m], $wTop+1);
}
else {
$OUT->FillAttr($FG_WHITE | $BG_BLUE, $menulen[$m], $menupos[$m], $wTop+1);
}
}
}
#==============
sub filledBox {
#==============
my($O, $color, $char, $left, $top, $width, $height) = @_;
my $row = 0;
for $row ($top..$top+$height) {
$O->FillAttr($color, $width, $left, $row);
$O->FillChar($char, $width, $left, $row);
}
}
#==============
sub borderBox {
#==============
my($O, $left, $top, $width, $height) = @_;
$O->FillChar(chr(218), 1, $left, $top);
$O->FillChar(chr(196), $width-2, $left+1, $top);
$O->FillChar(chr(191), 1, $left+$width-1, $top);
my $row = 0;
for $row ($top+1..$top+$height-1) {
$O->FillChar(chr(179), 1, $left, $row);
$O->FillChar(chr(179), 1, $left+$width-1, $row);
}
$O->FillChar(chr(192), 1, $left, $top+$height);
$O->FillChar(chr(196), $width-2, $left+1, $top+$height);
$O->FillChar(chr(217), 1, $left+$width-1, $top+$height);
}
#===========
sub Window {
#===========
my($O, $Attr, $Char, $Col, $Row, $Width, $Height) = @_;
filledBox($O, $Attr, $Char, $Col, $Row, $Width, $Height);
borderBox($O, $Col, $Row, $Width, $Height);
}
#==================
sub writeCentered {
#==================
my $O = shift;
my $S = (shift or "");
my $X = (shift or 0);
my $Y = (shift or 0);
$O->Cursor(int(($X-length($S))/2), $Y);
$O->Write($S);
}
#===============
sub millisleep {
#===============
require Win32 unless defined &Win32::GetTickCount;
my $ctick = Win32::GetTickCount();
my $etick = $ctick + $_[0];
while ($ctick < $etick) { $ctick = Win32::GetTickCount(); }
}
#================
sub explodeAttr {
#================
my $O = shift;
my $Attr = shift;
$Attr = $ATTR_INVERSE unless defined($Attr);
my($wLeft, $wTop, $wRight, $wBottom) = $O->Window();
my $X = $wRight-$wLeft;
my $Y = $wBottom-$wTop;
my $times = int( ($X>$Y)? ($Y/2) : ($X/2) );
my $left = $wLeft + int($X/2);
my $right = $wLeft + int($X/2);
my $top = $wTop + int($Y/2);
my $bottom = $wTop + int($Y/2);
my($cip, $ciop);
for $cip (0..$times) {
last if $times == 0;
for $ciop ($top..$bottom) {
$O->FillAttr($Attr, ($right-$left), $left, $ciop);
}
$top -= int(($Y/2)/$times);
$left -= int(($X/2)/$times);
$bottom += int(($Y/2)/$times);
$right += int(($X/2)/$times);
millisleep(5); # sleeps for 5 milliseconds
}
# the final touch
($wLeft, $wTop, $wRight, $wBottom) = $O->Window();
$X = $wRight-$wLeft+1;
$Y = $wBottom-$wTop+1;
$O->FillAttr($Attr, $X*$Y, $wLeft, $wTop);
}
#==============
sub showAbout {
#==============
my($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
my $X = $wRight-$wLeft;
my $Y = $wBottom-$wTop;
my $dX = 45;
my $dY = 8;
my $cX = $wLeft + int(($X-$dX)/2);
my $cY = $wTop + int(($Y-$dY)/2);
Window($OUT, $FG_WHITE | $BG_BLUE, " ", $cX, $cY, $dX, $dY);
$OUT->Attr($FG_WHITE | $BG_BLUE);
writeCentered($OUT, "Win32::Console version $Win32::Console::VERSION", $X, $cY+2);
writeCentered($OUT, "TEST SUITE", $X, $cY+4);
writeCentered($OUT, "by Aldo Calpini <dada\@divinf.it>", $X, $cY+5);
writeCentered($OUT, "Press any key or mouse button to continue", $X, $cY+6);
# save settings
my($oldX, $oldY, $oldS, $oldV) = $OUT->Cursor();
my $oldmode = $IN->Mode();
$IN->Mode(ENABLE_MOUSE_INPUT);
$OUT->Cursor(-1, -1, -1, 0); # hide the cursor
$IN->Flush();
# millisleep(500);
$IN->Flush();
my $color = 0;
$string = "TEST SUITE";
my $sX = int(($X-length($string))/2);
my $sY = $cY+4;
my $tX = $sX;
#
# watch what's happening without have
# to wait for something to happen
#
my @event = $IN->PeekInput();
until(($event[0]==1 and $event[1]==1)
or ($event[0]==2 and $event[3]!=0)) {
#
# cycle colors on "TEST SUITE"
#
$OUT->FillAttr($color | $BG_BLUE, 1, $tX, $sY);
$tX++;
if ($tX > $sX+length($string)) {
$tX = $sX ;
$color++;
$color = 0 if $color>15;
}
#
# process all pending input events
#
for(0..$IN->GetEvents()-1) {
@event = $IN->Input();
}
}
$IN->Flush();
# restore settings
$IN->Mode($oldmode);
$OUT->Cursor($oldX, $oldY, $oldS, $oldV);
}
#=============
sub testInfo {
#=============
# save settings
my $oldT = $OUT->Title();
my($oldX, $oldY, $oldS, $oldV) = $OUT->Cursor();
my($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
my $X = $wRight-$wLeft;
my $Y = $wBottom-$wTop;
my @towrite = ();
my @info = $OUT->Info();
push(@towrite, sprintf("Console screen buffer size: %3d, %3d", $info[0], $info[1]));
push(@towrite, sprintf("Current cursor position: %3d, %3d", $info[2], $info[3]));
push(@towrite, sprintf("Current attribute: %3d ", $info[4]));
push(@towrite, sprintf("Window coordinates: %3d, %3d-%3d, %3d", $info[5], $info[6],
$info[7], $info[8]));
push(@towrite, sprintf("Maximum window size: %3d, %3d", $info[9], $info[10]));
my $string = "";
my $max = 0;
foreach $string (@towrite) {
$max=length($string) if length($string)>$max;
}
my $dX = $max + 4;
my $dY = $#towrite + 4;
my $cX = $wLeft + int(($X-$dX)/2);
my $cY = $wTop + int(($Y-$dY)/2);
my $BACKGROUND = $OUT->ReadRect($cX, $cY, $cX+$dX, $cY+$dY);
Window($OUT, $FG_WHITE | $BG_BLUE, " ", $cX, $cY, $dX, $dY);
$OUT->Attr($FG_WHITE | $BG_BLUE);
for $row ($cY+1..$cY+1+$#towrite) {
$OUT->Cursor($cX+2, $row);
$OUT->Write($towrite[$row-$cY-1]);
}
writeCentered($OUT, "Press a key or mouse button to continue", $X, $cY+$#towrite+3);
$OUT->Cursor(-1, -1, -1, 0); # hide the cursor
$IN->Flush();
my @event = $IN->Input();
until(($event[0]==1 and $event[1]==1)
or ($event[0]==2 and $event[3]!=0)) {
@event = $IN->Input();
}
$IN->Flush();
$OUT->Window(1, $wLeft, $wTop, $wRight, $wBottom);
$OUT->WriteRect($BACKGROUND, $cX, $cY, $cX+$dX, $cY+$dY);
$OUT->Cursor($oldX, $oldY, $oldS, $oldV);
$OUT->Title($oldT);
}
#==============
sub testTitle {
#==============
# save settings
my $oldT = $OUT->Title();
my($oldX, $oldY, $oldS, $oldV) = $OUT->Cursor();
$OUT->Cursor(-1, -1, -1, 0); # hide the cursor
my($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
my $X = $wRight-$wLeft;
my $Y = $wBottom-$wTop;
my $dX = 14;
my $dY = 2;
my $cX = $wLeft + int(($X-$dX)/2);
my $cY = $wTop + int(($Y-$dY)/2);
my $BACKGROUND = $OUT->ReadRect($cX, $cY, $cX+$dX, $cY+$dY);
Window($OUT, $FG_WHITE | $BG_BLUE, " ", $cX, $cY, $dX, $dY);
$OUT->Attr($FG_WHITE | $BG_BLUE);
writeCentered($OUT, "Testing...", $X, $cY+1);
my $string = "I'M WRITING ON THE TITLE BAR! I'M WRITING ON THE TITLE BAR!";
my $c = 0;
for $c (0..length($string)) {
$OUT->Title(substr($string, 0, $c));
millisleep(50);
}
for $c (0..666) {
$OUT->Title("I'M FLASHING THE TITLE BAR! I'M FLASHING THE TITLE BAR!");
$OUT->Title("");
}
$OUT->WriteRect($BACKGROUND, $cX, $cY, $cX+$dX, $cY+$dY);
$OUT->Cursor($oldX, $oldY, $oldS, $oldV);
$OUT->Title($oldT);
}
#===============
sub testScroll {
#===============
# save settings
my $oldT = $OUT->Title();
my($oldX, $oldY, $oldS, $oldV) = $OUT->Cursor();
$OUT->Cursor(-1, -1, -1, 0); # hide the cursor
my($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
my $X = $wRight-$wLeft;
my $Y = $wBottom-$wTop;
my $dX = 48;
my $dY = 4;
my $cX = $wLeft + int(($X-$dX)/2);
my $cY = $wTop + int(($Y-$dY)/2);
filledBox($OUT, $FG_GRAY | $BG_BLACK, " ", $wLeft, $wTop+3, $wRight, $wBottom);
Window($OUT, $FG_WHITE | $BG_BLUE, " ", $cX, $cY, $dX, $dY);
$OUT->Attr($FG_WHITE | $BG_BLUE);
writeCentered($OUT, "Scrolling", $X, $cY+1);
writeCentered($OUT, "Scroll this window around with the arrow keys", $X, $cY+2);
writeCentered($OUT, "Press ESC to end test", $X, $cY+3);
$IN->Flush();
my $key = 0;
my @event = ();
my $test = 1;
my $return = "";
while ($key != 27) {
@event = $IN->Input();
if ($event[0] == 1 and $event[1]) {
# LEFT ARROW
if ($event[3] == 37 and $event[4] == 75 and $cX > $wLeft) {
$result = $OUT->Scroll($cX, $cY, $cX+$dX, $cY+$dY, $cX-1, $cY, " ", $FG_GRAY|$BG_BLACK, $wLeft, $wTop, $wRight, $wBottom);
$cX--;
}
# RIGHT ARROW
if ($event[3] == 39 and $event[4] == 77 and $cX < $wRight-$dX) {
$result = $OUT->Scroll($cX, $cY, $cX+$dX, $cY+$dY, $cX+1, $cY, " ", $FG_GRAY|$BG_BLACK, $wLeft, $wTop, $wRight, $wBottom);
$cX++;
}
# UP ARROW
if ($event[3] == 38 and $event[4] == 72 and $cY > $wTop+3) {
$result = $OUT->Scroll($cX, $cY, $cX+$dX, $cY+$dY, $cX, $cY-1, " ", $FG_GRAY|$BG_BLACK, $wLeft, $wTop, $wRight, $wBottom);
$cY--;
}
# DOWN ARROW
if ($event[3] == 40 and $event[4] == 80 and $cY < $wBottom-$dY) {
$result = $OUT->Scroll($cX, $cY, $cX+$dX, $cY+$dY, $cX, $cY+1, " ", $FG_GRAY|$BG_BLACK, $wLeft, $wTop, $wRight, $wBottom);
$cY++;
}
$key = $event[5];
}
}
$IN->Flush();
filledBox($OUT, $FG_GRAY | $BG_BLACK, " ", $cX, $cY, $dX, $dY);
$OUT->Cursor($oldX, $oldY, $oldS, $oldV);
$OUT->Title($oldT);
}
#============
sub testBox {
#============
# save settings
my $oldT = $OUT->Title();
my($oldX, $oldY, $oldS, $oldV) = $OUT->Cursor();
$OUT->Cursor(-1, -1, -1, 0); # hide the cursor
my($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
my @FG_COLORS=(
$FG_BLACK,
$FG_BLUE,
$FG_LIGHTBLUE,
$FG_RED,
$FG_LIGHTRED,
$FG_GREEN,
$FG_LIGHTGREEN,
$FG_MAGENTA,
$FG_LIGHTMAGENTA,
$FG_CYAN,
$FG_LIGHTCYAN,
$FG_BROWN,
$FG_YELLOW,
$FG_GRAY,
$FG_WHITE,
);
my @BG_COLORS=(
$BG_BLACK,
$BG_BLUE,
$BG_LIGHTBLUE,
$BG_RED,
$BG_LIGHTRED,
$BG_GREEN,
$BG_LIGHTGREEN,
$BG_MAGENTA,
$BG_LIGHTMAGENTA,
$BG_CYAN,
$BG_LIGHTCYAN,
$BG_BROWN,
$BG_YELLOW,
$BG_GRAY,
$BG_WHITE,
);
my $X = $wRight-$wLeft;
my $Y = $wBottom-$wTop;
my $dX = 30;
my $dY = 2;
my $cX = $wLeft + int(($X-$dX)/2);
my $cY = $wTop + int(($Y-$dY)/2);
$IN->Flush();
my $key = 0;
my @event = $IN->PeekInput();
my $x = 0;
my $y = 0;
my $w = 0;
my $h = 0;
my $FG = 0;
my $BG = 0;
until(($event[0]==1 and $event[1]==1)
or ($event[0]==2 and $event[3]!=0)) {
$x = rand($X);
$y = 3+rand($Y-3);
$w = rand($X-$x);
$h = rand($Y-$y);
$FG = $FG_COLORS[rand($#FG_COLORS)];
$BG = $BG_COLORS[rand($#BG_COLORS)];
if (rand(100)>50 and $w>2 and $h>2) {
borderBox($OUT, $x, $y, $w, $h);
}
else {
filledBox($OUT, $FG|$BG, " ", $x, $y, $w, $h);
}
# process all pending input events
for(0..$IN->GetEvents()-1) {
@event = $IN->Input();
}
}
$IN->Flush();
$OUT->Cursor($oldX, $oldY, $oldS, $oldV);
$OUT->Title($oldT);
}
#===============
sub testWindow {
#===============
# save settings
my $oldT = $OUT->Title();
my($oldX, $oldY, $oldS, $oldV) = $OUT->Cursor();
my($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
my $X = $wRight-$wLeft;
my $Y = $wBottom-$wTop;
my $dX = 14;
my $dY = 2;
my $cX = $wLeft + int(($X-$dX)/2);
my $cY = $wTop + int(($Y-$dY)/2);
my $BACKGROUND = $OUT->ReadRect($cX, $cY, $cX+$dX, $cY+$dY);
Window($OUT, $FG_WHITE | $BG_BLUE, " ", $cX, $cY, $dX, $dY);
$OUT->Attr($FG_WHITE | $BG_BLUE);
writeCentered($OUT, "Testing...", $X, $cY+1);
$OUT->Cursor(-1, -1, -1, 0); # hide the cursor
my($maxx, $maxy) = $OUT->MaxWindow();
$OUT->Window(1, 0, 0, $maxx, $maxy);
while ($maxx>1 and $maxy>1) {
$maxx--;
$maxy--;
$OUT->Window(1, 0, 0, $maxx, $maxy);
millisleep(50);
}
$OUT->Window(1, $wLeft, $wTop, $wRight, $wBottom);
$OUT->WriteRect($BACKGROUND, $cX, $cY, $cX+$dX, $cY+$dY);
$OUT->Cursor($oldX, $oldY, $oldS, $oldV);
$OUT->Title($oldT);
}
#===============
sub chooseTest {
#===============
# save settings
my $oldT = $OUT->Title();
my($oldX, $oldY, $oldS, $oldV) = $OUT->Cursor();
my($wLeft, $wTop, $wRight, $wBottom) = $OUT->Window();
my $X = $wRight-$wLeft;
my $Y = $wBottom-$wTop;
my $dX = 45;
my $dY = 6;
my $cX = $wLeft;
my $cY = $wTop + 3;
my $BACKGROUND = $OUT->ReadRect($cX, $cY, $cX+$dX, $cY+$dY);
Window($OUT, $FG_WHITE | $BG_BLUE, " ", $cX, $cY, $dX, $dY);
$OUT->Attr($FG_WHITE | $BG_BLUE);
$OUT->Cursor($wLeft+2, $cY+1); $OUT->Write("Console Info");
$OUT->Cursor($wLeft+2, $cY+2); $OUT->Write("Random Boxes");
$OUT->Cursor($wLeft+2, $cY+3); $OUT->Write("Scrolling");
$OUT->Cursor($wLeft+2, $cY+4); $OUT->Write("Title Bar");
$OUT->Cursor($wLeft+2, $cY+5); $OUT->Write("Window Size");
$IN->Flush();
my $key = 0;
my @event = ();
my $test = 1;
highlightTest(1);
my $return = "";
my($mX, $mY) = $OUT->Cursor();
while ($key != 27) {
@event = $IN->Input();
# A KEY PRESSED
if ($event[0] == 1 and $event[1]) {
# UP ARROW
if ($event[3] == 38 and $event[4] == 72 and $test > 1) {
$test=$test-1;
highlightTest($test);
}
# DOWN ARROW
if ($event[3] == 40 and $event[4] == 80 and $test < 5) {
$test=$test+1;
highlightTest($test);
}
$key = $event[5];
# ENTER
if ($key == 13) {
$return = ("", "testInfo", "testBox",
"testScroll", "testTitle", "testWindow")[$test];
$key = 27;
}
}
elsif ($event[0] == 2) {
$mX = $event[1];
$mY = $event[2];
if ($event[3] == 1) {
for $m (1..5) {
if (($mX >= $cX+1 and $mX <= $cX+$dX)
and ($mY == $cY+$m) ) {
$return = ("", "testInfo", "testBox",
"testScroll", "testTitle", "testWindow")[$m];
$key = 27;
}
}
}
}
$OUT->Cursor($mX, $mY);
}
$IN->Flush();
$OUT->WriteRect($BACKGROUND, $cX, $cY, $cX+$dX, $cY+$dY);
$OUT->Cursor($oldX, $oldY, $oldS, $oldV);
$OUT->Title($oldT);
return $return;
}
#==================
sub highlightTest {
#==================
my($i) = @_;
for $m (1..5) {
if ($m == $i) {
$OUT->FillAttr($FG_BLACK | $BG_WHITE, 43, $wLeft+1, $wTop+3+$m);
}
else {
$OUT->FillAttr($FG_WHITE | $BG_BLUE, 43, $wLeft+1, $wTop+3+$m);
}
}
}