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__

Replies are listed 'Best First'.
Re: GPM mouse handling
by zentara (Archbishop) on Feb 22, 2006 at 12:43 UTC
    Works for me on linux i686, with a PS2 Scrollwheel mouse. Neat.

    I'm not really a human, but I play one on earth. flash japh
Re: GPM mouse handling
by ghenry (Vicar) on Feb 25, 2006 at 18:57 UTC

    Very cool. linux-i686, perl 5.8.6, usb mouse.

    Gavin.

    Walking the road to enlightenment... I found a penguin and a camel on the way.....
    Fancy a yourname@perl.me.uk? Just ask!!!