This little script demonstrates how you can use gpm in the low-level way (reading directly from the socket without using the gpm library).
You can drag the mouse around the screen to draw a trace. The left and right mouse button behaves differently, normally the left button draws stars, the right button blanks, but you can change this by pressing control-A (for the left button) or control-E (for the right button) and then the character you want to draw. You can also write text to where you have placed the cursor by typeing it. Enter and backspace edits the text the way you expect it.
You have to run this on the console (i.e., when the tty program says /dev/tty1 or /dev/vc/1 for some values of 1), and gpm has to be running.
This was only tested on linux-i686 with perl 5.8.8.
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 wri
+tes 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__
