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__

[download]

In reply to GPM mouse handling by ambrus

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.