#!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of X11-Protocol-Other.
#
# X11-Protocol-Other is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# X11-Protocol-Other is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with X11-Protocol-Other. If not, see <http://www.gnu.org/licenses/>.
# Usage: perl mit-screen-saver-external.pl
#
# This is an example of an external screen saver using the MIT-SCREEN-SAVER
# extension (X11::Protocol::Ext::MIT_SCREEN_SAVER).
#
# MitScreenSaverSetAttributes() sets up the program to be an external saver
# and defines the saver window attributes for when the saver turns on.
# MitScreenSaverSelectInput() sets up to listen for when the saver does in
# fact turn on. Then redraw() is a moving blob in the saver window while
# active.
#
#
# Drawing:
#
# redraw() is done on a timer at $frame_rate many times per second. An
# IO::Select is used to wait for either an event from the server or the
# desired time. When the saver is off there's no timeout, just wait for
# events.
#
# The timeout ought to be the time from now until the next draw is due, and
# in theory the time ought to be only until the blob moves by a whole pixel.
# But it's much easier to consider a draw every select(). This is normally
# fine since there shouldn't be many events from the server and so most
# selects end for time not for input.
#
# The main loop also listens to STDIN for "f" from the user to force the
# screen saver on, so you don't have to wait to see the demo. In a real
# program you'd probably ignore STDIN since the program would usually run in
# the background with stdin either closed at startup or ignored.
#
# An error handler guards against the saver turning off during drawing.
# When the saver turns off the saver window cannot be used and drawing to it
# results in Drawable or Window errors.
#
# An error handler is necessary. Errors from drawing can't be avoided by
# checking the saver state. Even if the saver is On when the drawing
# requests are sent out it might be off by the time those requests reach the
# server.
#
# The drawing isn't very sophisticated, but does try to reduce flashing by
# clearing only the newly revealed background part of the window when moving
# the blob. A fancier program could draw a new frame to a pixmap and then
# copy that to the screen, or similar with the DOUBLE-BUFFER extension if
# available (X11::Protocol::Ext::DOUBLE_BUFFER).
#
# Incidentally the saver window doesn't have to be the full screen. It can
# be something in the middle of the screen, leaving some normal screen
# content around the edges (which will update as normal if any clients are
# drawing, such as a clock).
#
#
# Another Screen Saver Running:
#
# The error handler notices an Access error from
# MitScreenSaverSetAttributes() which occurs if there's another external
# saver program running already. MitScreenSaverSetAttributes() doesn't have
# a reply when successful, so only the error packet says it didn't work.
# A round-trip QueryPointer ensures any error is detected before going into
# the main loop.
#
# Xlib XScreenSaverSaverRegister() has a scheme where a running saver
# program identifies itself by an XID stored in an "_MIT_SCREEN_SAVER_ID"
# property on the root window. That allows an existing saver to be forcibly
# killed ($X->KillClient()) if desired, though whether that's a good idea
# when starting a new saver is another matter. There's nothing in
# X11::Protocol::Ext::MIT_SCREEN_SAVER for that as yet. Some care might be
# needed when owning that property not to leave behind a bogus XID if killed
# (because that XID could be assigned to another client). Perhaps
# SetCloseDownMode() to preserve an identifying pixmap.
#
#
# Other Ways to Do It:
#
# For reference, the xscreensaver program has other ways to do a saver, as
# described in the comments at the start of its xscreensaver.c. In addition
# to MIT-SCREEN-SAVER it can detect idleness with the old (and perhaps no
# longer available) XIdle extension, or with the SCREEN_SAVER on SGI Irix,
# and can even try some slightly nasty keypress events and polling the mouse
# pointer position. And then it normally prefers to blank with an
# override-redirect window covering the screen.
#
# Apparently xscreensaver struck server bugs in the MIT-SCREEN-SAVER
# extension and for that reason recommends XIdle or SGI SCREEN_SAVER in its
# config.h.in. Recent X.org servers don't seem to crash, and the note in
# config.h.in about trouble "fading" with MIT-SCREEN-SAVER might be due to
# setting a background_pixel colour in the way done in the code here. If
# you omit that then like other windows the saver window leaves existing
# screen content unchanged when it's mapped. (And from there could be
# manipulated with colormap trickery, or perhaps RENDER extension merging,
# or even some GetImage/PutImage.)
#
use strict;
use IO::Select;
use X11::Protocol;
use List::Util 'min';
use Time::HiRes 'usleep';
use POSIX 'fmod';
my $frame_rate = 20;
my $seconds_per_trip = 60;
my $X = X11::Protocol->new;
if (! $X->init_extension('MIT-SCREEN-SAVER')) {
print STDERR "MIT-SCREEN-SAVER extension not available\n";
exit 1;
}
my $orig_error_handler = $X->{'error_handler'};
local $X->{'error_handler'} = sub {
my ($X, $data) = @_;
my ($type, $seq, $info, $minor_op, $major_op) = unpack 'xCSLSC', $data;
$type = $X->interp('Error',$type);
$major_op = $X->interp('Request',$major_op);
if ($type eq 'Access') {
# could check $major_op is the saver extension opcode and $minor_op is
# MitScreenSaverSetAttributes
#
print STDERR "Another screen saver is running\n";
exit 1;
} elsif (($type eq 'Window' || $type eq 'Drawable')
&& ($major_op eq 'ClearArea' || $major_op eq 'PolyFillRectangle')) {
# screen saver turned off during drawing, ignore errors from the drawing
# requests
} else {
goto $orig_error_handler;
}
};
# listen for MitScreenSaverNotify
$X->MitScreenSaverSelectInput ($X->root, 0x01);
# screen saver window same depth as root
#
$X->MitScreenSaverSetAttributes
($X->root,
'InputOutput', # class
0, # depth, from parent
'CopyFromParent', # visual
0,0, # x,y
$X->width_in_pixels,
$X->height_in_pixels,
0, # border
background_pixel => $X->black_pixel,
);
# round-trip query so as to get any Access error from
# MitScreenSaverSetAttributes() before printing the startup message below
#
$X->QueryPointer ($X->root);
my $gc = $X->new_rsrc;
$X->CreateGC ($gc, $X->root, foreground => $X->white_pixel);
my %saver_notify = (state => 'Off');
sub saver_is_active {
return $saver_notify{'state'} eq 'On'
&& $saver_notify{'kind'} eq 'External';
}
$X->{'event_handler'} = sub {
my (%h) = @_;
if ($h{'name'} eq 'MitScreenSaverNotify') {
%saver_notify = %h;
}
};
# width and height of a single pixel
my $pixel_width_mm = $X->width_in_millimeters / $X->width_in_pixels;
my $pixel_height_mm = $X->height_in_millimeters / $X->height_in_pixels;
my $blob_width = int ($X->width_in_pixels / 20);
my $blob_height = int ($blob_width * ($pixel_height_mm / $pixel_width_mm));
my $blob_x_limit = $X->width_in_pixels - $blob_width;
# middle of the screen vertically
my $blob_y = int (($X->height_in_pixels - $blob_height) / 2);
# Return $x of current desired blob position. Time $seconds_per_trip
# corresponds to across and back, which is 2*$blob_x_limit pixels.
sub blob_x {
my $t = Time::HiRes::time();
my $x = int (2 * $blob_x_limit * fmod($t / $seconds_per_trip, 1));
if ($x >= $blob_x_limit) {
$x = 2*$blob_x_limit-1 - $x;
}
return $x;
}
my $last_blob_x = 0; # last drawn position
sub redraw {
return unless saver_is_active();
my $window = $saver_notify{'window'};
my $blob_x = blob_x();
my ($clear_x, $clear_width);
if ($blob_x > $last_blob_x) {
$clear_x = $last_blob_x;
$clear_width = min ($blob_width, $blob_x - $last_blob_x);
} else {
$clear_width = min ($blob_width, $last_blob_x - $blob_x);
$clear_x = $last_blob_x + $blob_width - $clear_width;
}
if ($clear_width) {
$X->ClearArea ($window, $clear_x,$blob_y, $clear_width,$blob_height);
}
$X->PolyFillRectangle ($window, $gc,
[$blob_x, $blob_y, $blob_width-1, $blob_height-1]);
$last_blob_x = $blob_x;
}
sub handle_stdin {
my $line = <STDIN>;
if (! defined $line || $line =~ /^q(uit)?/i) {
exit 0;
}
if ($line =~ /^f(orce)?/i) {
print "Force screen saver on ...\n";
# Sleep to wait for the key release from the user pressing Return.
# Could a fancier program check for all keys released ?
sleep 1;
$X->ForceScreenSaver ('Activate');
}
}
my $X_fh = $X->{'connection'}->fh;
my $select = IO::Select->new ($X_fh, \*STDIN);
print "Waiting for idle, type \"f Return\" to force it.\n";
print "Type \"q Return\" to exit.\n";
for (;;) {
$X->flush;
my $timeout = (saver_is_active() ? 1/$frame_rate : 0);
foreach my $readable ($select->can_read($timeout)) {
if ($readable == $X_fh) {
$X->handle_input;
} elsif ($readable == \*STDIN) {
handle_stdin();
}
}
redraw();
}
exit 0;