#!/usr/bin/perl -w

# $Id: smgtest,v 1.3 1998/11/03 03:17:37 daniel Exp daniel $

use strict;
use ExtUtils::testlib;
use Term::Slang;

my $sl = Term::Slang->new;

$sl->init_smg;
$sl->SLang_init_tty(-1,0,1);
$sl->smg_init_smg;
$sl->SLkp_init;

my ($s_rows,$s_cols) = $sl->SLtt_get_screen_size;

my @colors = qw(
	black red green brown blue magenta cyan lightgray gray brightred
	brightgreen yello brightblue brightmagenta brightcyan white
);
my $num_colors = scalar @colors;

init_colors();
	
$sl->SLtt_set_mouse_mode(1,0);

menu_loop();

quit();
###############

sub quit {
	$sl->SLang_reset_tty;
	$sl->smg_reset_smg;
	exit;
}

sub print_menu {
	$sl->SLsig_block_signals;
	$sl->smg_cls;
	
	my $row = 2;
	my $i   = 1;

	my @names = (
		'Color Test',
		'Alt charset test',
		'Key Escape Sequence Report',
		'Line Drawing Test',
		'Test Mouse',
		'Box Test',
		'Test Low Level Functions',
		'Quit',
	);

	for my $name (@names) {
		$sl->smg_gotorc($row, 3);
		$sl->smg_write_string("$i $name");
		$row++;
		$i++;
	}
	
	$row = 0;
	$sl->smg_gotorc($row, 1);
	$sl->smg_write_string('Choose number:');
	
	$sl->smg_refresh;
	$sl->SLsig_unblock_signals;
}

sub menu_loop {
	print_menu();

	my @names = ('',
		\&color_test,\&alt_char_test,\&esc_seq_test,\&line_test,
		\&mouse_test,\&box_test,\&low_level_test,\&quit,
	);
	
	while (1) {
		my $ch = chr $sl->SLkp_getkey;
		if ($names[$ch]) {
			&{$names[$ch]};
		} elsif ($ch eq '\r') {
			next;
		} else {
			$sl->SLtt_beep;
		}
		print_menu();
	}
}

sub write_centered_string {
	my ($s,$row) = @_;
	my $col;

	return if $s =~ /^\s*$/;
	my $len = length $s;  

	# Want 2 * col + len == $sl->SLtt_Screen_Rows 
	$col = $len >= $s_cols ? 0 : ($s_cols - $len) / 2;

	$sl->smg_gotorc($row,$col);
	$sl->smg_write_string($s);
}

sub pre_test {
	my $title = shift;
	$sl->SLsig_block_signals;
	$sl->smg_cls;
	write_centered_string($title,0);
}

sub post_test {
	write_centered_string('Press any key to return.',$s_rows - 1);
	$sl->smg_refresh;
	$sl->SLsig_unblock_signals;
	$sl->SLkp_getkey;
}

sub init_colors {
	for(my $i = 0; $i < $num_colors; $i++) {
		$sl->SLtt_set_color($i+1,'','black',$colors[$i]);
	}
}

# The tests.
sub box_test  {
	my $msg = 'This is a box with changing background';
	my $color;

	pre_test('Box Test');
	
	my $dr = 8;
	my $dc = 4 + length $msg;
	my $r  = $s_rows / 2 - $dr/2;
	my $c  = $s_cols / 2 - $dc/2;

	$sl->smg_set_color(1);
	$sl->SLsmg_set_char_set(1);
	$sl->SLsmg_fill_region($r + 1, $c + 1, $dr - 2, $dc - 2, 'a');
	$sl->SLsmg_set_char_set(0);
	$sl->smg_set_color(0);
	$sl->smg_gotorc($r + $dr/2, $c + 2);
	$sl->smg_write_string($msg);
	$sl->smg_draw_box($r, $c, $dr, $dc);

	$sl->smg_refresh;

	$color = 2;
	while (0 == $sl->SLang_input_pending(10)) {
		$sl->smg_set_color_in_region($color,$r,$c,$dr,$dc);
		$sl->smg_refresh;
		$color++;
		$color = $color % $num_colors;
	}
	post_test();
}

sub color_test {
	pre_test('Color Test');
	
	my $row = 1;
	my $color = 0;
	while ($row < $s_rows - 1) {
		$color = $color % $num_colors;

		$sl->smg_gotorc($row, 0);
		$sl->smg_set_color(0);
		$sl->smg_write_string($colors[$color]);
		$color++;
		$sl->smg_set_color($color);
		$sl->smg_erase_eol;
		$row++;
	}
	
	$sl->smg_set_color(0);
	post_test();
}

sub alt_char_test {
	pre_test('Alternate Charset Test');
	
	my $row = $s_rows / 2 - 2;
	my $col = 0;

	for (my $ch = 32; $ch < 128; $ch++) {
		$sl->smg_gotorc($row, $col);
		$sl->SLsmg_write_char(chr $ch);
		$sl->smg_gotorc($row + 1, $col);
		$sl->SLsmg_set_char_set(1);
		$sl->SLsmg_write_char(chr $ch);
		$sl->SLsmg_set_char_set(0);
		$col++;
	
		if ($col > 40) {
			$col  = 0;
			$row += 4;
		}
	}
	post_test();
}

sub line_test {
	pre_test('Line Test');
	
	my $row = 4;
	my $col = 2;
	$sl->smg_gotorc($row, $col);
	$sl->smg_draw_hline(10);
	$sl->smg_write_string('Result of SLsmg_draw_hline(10)');
	$sl->smg_draw_vline(5);
	$sl->smg_write_string('Result of SLsmg_draw_vline(5)');

	post_test();
}


sub esc_seq_test {
	pre_test('Escape Sequence Report');
	
	my $row = $s_rows / 2;
	
	$sl->smg_gotorc($row, 0);
	$sl->smg_write_string('Press key: ');
	$sl->smg_refresh;
	
	$sl->smg_gotorc($row, 0);
	$sl->smg_write_string('Key returned ');

	my $ch = $sl->SLang_getkey;
	my $buf = '"';

	if ($ch >= 127) {
		$buf .= sprintf("\\d%d", $ch);

	} elsif ($ch eq '"' or $ch eq '\\') {
	    $buf .= '\\'.chr $ch;

	} else { 
		$buf .= chr $ch;
	}

	while ($sl->SLang_input_pending(3) > 0) {}

	$buf .= '"';
	$sl->smg_write_string($buf);
	post_test();
}

sub mouse_test {
	pre_test('Mouse Test');
	
	my $row = $s_rows / 2;
	
	$sl->smg_gotorc($row, 0);
	$sl->smg_write_string('Click Mouse: ');
	$sl->smg_refresh;

	my $ch = $sl->SLang_getkey;
	
	if ($ch != 27) { 
		$sl->smg_gotorc($row, 0);
		$sl->smg_write_string('That did not appear to be a mouse escape sequence');
		$sl->smg_gotorc($row+1,0);
		$sl->smg_write_string("You pressed: $ch");
		post_test();
		return;
	}
	
	my $b = $sl->SLang_getkey;
	my $x = $sl->SLang_getkey;
	my $y = $sl->SLang_getkey;
	
	$sl->smg_gotorc($row, 0);
	$sl->smg_write_string("Button: $b     ");
	$sl->smg_gotorc($row + 1, 0);
	$sl->smg_write_string("Column: $x");
	$sl->smg_gotorc($row + 2, 0);
	$sl->smg_write_string("   Row: $y");
	$sl->SLang_getkey;
	$sl->SLang_getkey;
	post_test();
}

sub low_level_test {
	#if ($sl->SLtt_Term_Cannot_Scroll) {
	#	pre_test('Sorry!  Your terminal lacks scrolling capability.');
	#	post_test();
	#	return;
	#}

	$sl->smg_suspend_smg;
	$sl->SLtt_init_video;

	my $mid = $s_rows / 2;
	my $bot = $s_rows - 1;

	$sl->SLtt_cls;
	$sl->SLtt_goto_rc(0, 0);
	$sl->SLtt_write_string("The following set of tests are designed to test the display system.");
	$sl->SLtt_goto_rc(1, 0);
	$sl->SLtt_write_string("There should be a line of text in the middle and one at the bottom.");
	$sl->SLtt_goto_rc($mid, 0);
	$sl->SLtt_write_string("This line is in the middle.");
	$sl->SLtt_goto_rc($bot, 0);
	$sl->SLtt_write_string("This line is at the bottom.");
	
	$sl->SLtt_goto_rc(2, 0); 
	$sl->SLtt_write_string("Press return now.");
	$sl->SLtt_flush_output;
	$sl->SLang_flush_input;
	$sl->SLang_getkey;
	
	$sl->SLtt_goto_rc(2, 0);
	$sl->SLtt_write_string("The middle row should slowly move down next the bottom and then back up.");
	$sl->SLtt_goto_rc($mid - 1, 0);
	$sl->SLtt_write_string("This line should not move.");
	$sl->SLtt_goto_rc($mid + 1, 0);
	$sl->SLtt_write_string("This line should vanish at the bottom");
	$sl->SLtt_goto_rc($mid + 1, $s_cols - 5);
	$sl->SLtt_write_string("End->");
	$sl->SLtt_flush_output;

	$sl->SLtt_set_scroll_region($mid, $bot - 1);
	
	my $r = ($bot - $mid) - 1;

	while ($r > 0) {
		$sl->SLang_input_pending(2); # 3/10 sec delay
		$sl->SLtt_goto_rc(0,0);	     # relative to scroll region 
		$sl->SLtt_reverse_index(1);
		$sl->SLtt_flush_output;
		$r--;
	}
	
	$r = ($bot - $mid) - 1;
	while ($r > 0) {
		$sl->SLang_input_pending(2);
		$sl->SLtt_goto_rc(0,0);
		$sl->SLtt_delete_nlines(1);
		$sl->SLtt_flush_output;
		$r--;
	}
	
	$sl->SLtt_reset_scroll_region;
	$sl->SLtt_goto_rc($mid - 1, 0);
	$sl->SLtt_write_string("Now the bottom will come up and clear the lines below");
	
	$sl->SLtt_set_scroll_region($mid, $bot);
	$r = ($bot - $mid) + 1;
	while ($r > 0) {
		$sl->SLang_input_pending(2);
		$sl->SLtt_goto_rc(0,0);
		$sl->SLtt_delete_nlines(1);
		$sl->SLtt_flush_output;
		$r--;
	}

	$sl->SLtt_reset_scroll_region;
	$sl->SLtt_goto_rc(3,0);
	$sl->SLtt_write_string("This line will go down and vanish");
	$sl->SLtt_set_scroll_region(3, $mid - 2);

	$r = (($mid - 2) - 3) + 1;
	while ($r > 0) {
		$sl->SLang_input_pending(3);
		$sl->SLtt_goto_rc(0,0);
		$sl->SLtt_reverse_index(1);
		$sl->SLtt_flush_output;
		$r--;
	}
	
	
	$sl->SLtt_reset_scroll_region;
	$sl->SLtt_set_scroll_region(1,1);
	$sl->SLtt_goto_rc (0,0);
	$sl->SLtt_delete_nlines(1);
	$sl->SLtt_reset_scroll_region;
	$sl->SLtt_set_scroll_region(2,2);
	$sl->SLtt_goto_rc (0,0);
	$sl->SLtt_reverse_index(1);
	$sl->SLtt_reset_scroll_region;

	$sl->SLtt_goto_rc(1, 10);
	$sl->SLtt_write_string("Press Any Key To Continue.");
	$sl->SLtt_flush_output;
	$r = 15;

	#if (0 == $sl->SLtt_Term_Cannot_Insert) {
		while ($r) {
			$r--;
			$sl->SLtt_goto_rc(1, 0);
			$sl->SLtt_begin_insert;
			$sl->SLtt_putchar(' ');
			$sl->SLtt_end_insert;
			$sl->SLtt_flush_output;
			$sl->SLang_input_pending(2);
		}
	#}
	
	$sl->SLang_flush_input;
	$sl->SLang_getkey;   
	
	$sl->SLtt_reset_video;
	$sl->smg_resume_smg;
}
