use warnings;
use strict;
use IO::Handle; 
use Socket; 
my($G, $px, $pxo, $py, $ev, $bu, $nx, $ny, $m, $sm, $sm0, $key, $mk, $mk1, $mk2, $kst, $k, @ss);
socket $G, PF_UNIX(), SOCK_STREAM(), 0 or die
	"cannot socket: $!"; 
connect $G, sockaddr_un("/dev/gpmctl") or die
	"cannot connect gpmctl: $!"; 
@ss = stat STDIN or
	die "cannot stat stdin: $!";
0x0400 == ($ss[6] & 0xff00) or
	die "error: must be started from console";
printflush $G pack("S!S!S!S!ii", 0x7e, 0x0001, 0, 0, $$, $ss[6] & 0xff) or die;
sub clear() {
	print "\e[H\e[J" .
		"Gpm mouse test by ambrus. Draw or place cursor with mouse,\n" .
		"^A or ^E sets markers, ^L clears, ^D exits, any other key writes text.\n";
	$mk1 = "*"; $mk2 = " ";
	($pxo, $px, $py) = (1, 1, 3);
}
clear;
flush STDOUT;
$sm0 = ""; 
vec($sm0, fileno(STDIN), 1) = 1;
vec($sm0, fileno($G), 1) = 1;
$ev = $key = "";
$kst = "";
sub mark {
	printf "\e[%d;%dH%s", $_[1], $_[0], $_[2]; 
}
$SIG{"INT"} = sub { cleanup(); exit; };
system "stty", qw"-icanon -echo -echonl -echoke -echoe" and
	die "error during stty";
MAIN: while (select $sm = $sm0, undef, undef, undef) {
	0 != vec($sm, fileno($G), 1) and do {
		sysread $G, $ev, 1024, length($ev) or
			die "error reading gpmctl: $!";
		while (length(pack("C2S!7i3")) < length($ev)) {
			($bu, undef, undef, undef, undef, $nx, $ny, $m) = 
				unpack "CCS!s!s!s!s!iiis!s!a*", substr $ev, 0, length(pack("C2S!7i3")), "";
			$mk = 0 != (~4 & $bu) ? $mk2 : $mk1;
			0 != ($m & 0x06) and
				mark $nx, $ny, $mk; 
			0 != ($m & 0x02) && 
				defined($px) && 
				(2 <= abs($nx - $px) || 2 <= abs ($ny - $py)) and do {
				if (abs($nx - $px) < abs($ny - $py)) {
					mark int($px + ($nx - $px) * ($_ - $py) / ($ny - $py)), $_, $mk
						for $py < $ny ?
							$py + 1 .. $ny - 1 :
							$ny + 1 .. $py - 1;
				} else {
					mark $_, int($py + ($ny - $py) * ($_ - $px) / ($nx - $px)), $mk
						for $px < $nx ?
							$px + 1 .. $nx - 1 :
							$nx + 1 .. $px - 1;
				}
			};
			($pxo, $px, $py) = ($nx, $nx, $ny);
		}
	};
	0 != vec($sm, fileno(STDIN), 1) and do {
		sysread STDIN, $key, 1024 or
			die "error reading stdin: $!";
		while ($key =~ /(.)/sg) {
			$k = $1;
			if ("\ca" eq $k) {
				$kst = "mk1";
			} elsif ("\ce" eq $k) {
				$kst = "mk2";
			} else {
				if ("mk1" eq $kst && $1 =~ /([[:print:]])/) {
					$mk1 = $1;
				} elsif ("mk2" eq $kst && $1 =~ /([[:print:]])/) {
					$mk2 = $1;
				} elsif ("\cd" eq $k) {
					last MAIN;
				} elsif ("\f" eq $k) {
					clear();
				} elsif ("\n" eq $k || "\r" eq "k") {
					$px = $pxo; 
					++$py;
				} elsif ("\x7f" eq $k || "\b" eq "k") {
					mark --$px, $py, " ";
				} elsif ($k =~ /([[:print:]])/) {
					mark $px++, $py, $1;
				}
				$kst = "";
			}
		}
	};
	mark $px, $py, "";
	flush STDOUT;
}
sub cleanup {
	print "\e[9999H";
	system "stty", "sane" and
		warn "cannot reset stty settings";
}
cleanup;
__END__