The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# TCtest.pl
#
# test program to exercise the screen contol module
#
# by Mark Kaehny 1995
# this file is available under the same terms as the perl language 
# distribution. See the Artistic License.
#

use strict;
use warnings;

require Term::Screen;

my $scr = Term::Screen->new();

#test clear screen and output
$scr->clrscr();
$scr->puts("Test series for Screen.pm module for perl5");

# test cursor movement, output and linking together
$scr->at(2,3)->puts("1. Should be at row 2 col 3 (upper left is 0,0)");

#test current position update
my $r = $scr->{'r'} || 0; 
my $c = $scr->{'c'} || 0;
$scr->at(3,0)->puts("2. Last position $r $c -- should be 2 50.");

#test rows and cols ( should be updated for signal )
$scr->at(4,0)->puts("3. Screen size: " . ($scr->{'rows'} || 0 ) . " rows and " . 
                                           ( $scr->{'cols'} || 0 ) . " columns.");
# test standout and normal test
$scr->at(6,0);
$scr->puts("4. Testing ")->reverse()->puts("reverse");
$scr->normal()->puts(" mode, ");
$scr->bold()->puts("bold")->normal()->puts(" mode, ");
$scr->bold()->reverse()->puts("and both")->normal()->puts(" together.");

# test clreol 
# first put some stuff up
my $line = "0---------10--------20--------30--------40--------50--------60--------70-------";
$scr->at(7,0)->puts("5. Testing clreol - " . 
                      "   The next 2 lines should end at col 20 and 30.");
for (8 .. 10) {$scr->at($_,0)->puts($line);}
$scr->at(8,20)->clreol()->at(9,30)->clreol();

# test clreos
for (11 .. 20) { $scr->at($_,0)->puts($line); }
$scr->at(11,0)->puts("6. Clreos - Hit a key to clear all right and below:");
$scr->getch();
$scr->clreos();

#test insert line and delete line
$scr->at(12,0)->puts("7. Test insert and delete line - 15 deleted, and ...");
for (13 .. 16) { $scr->at($_,0)->puts($_ . substr($line,2)); }
$scr->at(15,0)->dl();
$scr->at(14,0)->il()->at(14,0)->puts("... this is where line 14 was");

# test key_pressed
$scr->at(18,0)->puts("8. Key_pressed - Don't Hit a key in the next 5 seconds: ");
if ($scr->key_pressed(5)) { $scr->puts("HEY A KEY WAS HIT"); } 
  else { $scr->puts("GOOD - NO KEY HIT!"); }
$scr->at(19,0)->puts("Hit a key in next 15 seconds: ");
if ($scr->key_pressed(15)) { $scr->puts("KEY HIT!"); } 
  else { $scr->puts("NO KEY HIT"); }

# test getch
# clear buffer out
$scr->flush_input();
$scr->at(21,0)->puts("Testing getch, Enter Key (q to quit): ")->at(21,40);
my $ch = '';
while(($ch = $scr->getch()) ne 'q') 
{
  if (length($ch) == 1) 
    {
      $scr->at(21,50)->clreol()->puts("ord of char is: ");
      $scr->puts(ord($ch))->at(21,40);
    }
  else 
    {
      $scr->at(21,50)->clreol()->puts("function value: $ch");
      $scr->at(21,40);
    }
}

$scr->at(22,0);