The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# 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);
        }
    }
}