#!/usr/bin/perl -w # Create a random pokey cartoon for xscreensaver # Waider August 14 2003 # put this into your .xscreensaver to make it work # "RandomPokey" randompokeyhack.pl # and note that the preview won't work in the config front-end # and also you may be left with /tmp/rpNNNN directories because I'm # too lazy to do proper cleanup. use LWP::UserAgent; use strict; # 1. get the list of cartoons, so we know how many there are. # http://www.lysator.liu.se/pokey/archive/ my $ua = new LWP::UserAgent; $ua->env_proxy(); my $content; my $req = new HTTP::Request GET => "http://www.lysator.liu.se/pokey/archive/"; my $res = $ua->request( $req ); if ( $res->is_success ) { $content = $res->content; } else { die "Can't get index page.\n"; } # Find the max number off the list my ( $max ) = $content =~ m/^.*index(\d+).html\D+$/si; my @images; # Right, now let's make up a cartoon. If it's over four frames, we'd # better check if the frames exist. my $frames = int( rand( 3 )) + 3; # 4 - 7 frames mkdir ( "/tmp/rp$$" ) || die "someone's trying to hack us"; # Fetch the images into a tmpdir $req = new HTTP::Request GET => "http://www.lysator.liu.se/pokey/archive/pokey.gif"; $res = $ua->request( $req ); if ( $res->is_success ) { saveimg( $res->content, "logo" ); } else { die "Can't get pokey logo.\n"; } while ( 1 ) { # Ideally, we'd use GD to play here, but GD may not have GIF support, # so DOOM! DOOM! # cheeziness ensues my $cmd = "/usr/X11R6/bin/xview -quiet -onroot -at 0,0 /tmp/rp$$/logo "; my ( $i, @i ); for $i ( 0..$frames ) { $i[ $i ] = int( rand( $max ) + 1 ); $req = new HTTP::Request GET => "http://www.lysator.liu.se/pokey/archive/pokey$i[$i]_" . ( $i+1 ) . ".gif"; $res = $ua->request( $req ); if ( !$res->is_success ) { last; # end the cartoon here. } saveimg( $res->content, "$i" ); $cmd .= "-merge -at 0," . 110 * ( $i + 1 ) . " /tmp/rp$$/$i "; } # xview can read gifs but not dump them. tools. $cmd .= "-clip 0,0,500," . 110 * ( $frames + 1 ) . " -dump jpeg /tmp/rp$$/assembled"; system( $cmd ); system( "xview -center -onroot -quiet /tmp/rp$$/assembled" ); # clean up unlink( "/tmp/rp$$/assembled" ); for my $i ( 0 .. $frames ) { unlink( "/tmp/rp$$/$i" ); } sleep( 10 ); } sub saveimg { my ( $data, $name ) = @_; open( IMG, ">/tmp/rp$$/$name" ) or die $!; binmode( IMG ); print IMG $data; close( IMG ); } END { unlink( "/tmp/rp$$/logo" ); rmdir( "/tmp/rp$$" ); }