#!/usr/bin/perl -w
-# vidwhacker, for xscreensaver. Copyright (c) 1998-2001 Jamie Zawinski.
+# vidwhacker, for xscreensaver. Copyright (c) 1998-2006 Jamie Zawinski.
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
use strict;
my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.21 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $version = q{ $Revision: 1.29 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
my $verbose = 0;
my $use_stdin = 0;
my $screen_width = -1;
+my $displayer = "xscreensaver-getimage -root -file";
-
-# #### This list was lifted from driver/xscreensaver-getimage-file
-#
-# These are programs that can be used to put an image file on the root
-# window (including virtual root windows.) The first one of these programs
-# that exists on $PATH will be used (with the file name as the last arg.)
-#
-# If you add other programs to this list, please let me know!
-#
-my @displayer_programs = (
- "xv -root -quit -viewonly -maxpect -noresetroot -quick24 -rmode 5" .
- " -rfg black -rbg black",
- "xli -quiet -fullscreen -onroot -center -border black",
- "xloadimage -quiet -fullscreen -onroot -center -border black",
- "chbg -once -xscreensaver -max_grow 4",
-
-# this lame program wasn't built with vroot.h:
-# "xsri -scale -keep-aspect -center-horizontal -center-vertical",
-);
+sub which($);
# apparently some versions of netpbm call it "pamoil" instead of "pgmoil"...
#
);
-sub error {
- ($_) = @_;
- print STDERR "$progname: $_\n";
+# Any files on this list will be deleted at exit.
+#
+my @all_tmpfiles = ();
+
+sub exit_cleanup() {
+ print STDERR "$progname: delete tmp files\n" if ($verbose);
+ unlink @all_tmpfiles;
+}
+
+sub signal_cleanup() {
+ my ($sig) = @_;
+ print STDERR "$progname: caught SIG$sig\n" if ($verbose);
exit 1;
}
-# #### Lifted from driver/xscreensaver-getimage-file
-#
-sub pick_displayer {
- my @names = ();
-
- foreach my $cmd (@displayer_programs) {
- $_ = $cmd;
- my ($name) = m/^([^ ]+)/;
- push @names, "\"$name\"";
- print STDERR "$progname: looking for $name...\n" if ($verbose > 2);
- foreach my $dir (split (/:/, $ENV{PATH})) {
- print STDERR "$progname: checking $dir/$name\n" if ($verbose > 3);
- return $cmd if (-x "$dir/$name");
- }
- }
+sub init_signals() {
- $names[$#names] = "or " . $names[$#names];
- printf STDERR "$progname: none of: " . join (", ", @names) .
- " were found on \$PATH.\n";
- exit 1;
+ $SIG{HUP} = \&signal_cleanup;
+ $SIG{INT} = \&signal_cleanup;
+ $SIG{QUIT} = \&signal_cleanup;
+ $SIG{ABRT} = \&signal_cleanup;
+ $SIG{KILL} = \&signal_cleanup;
+ $SIG{TERM} = \&signal_cleanup;
+
+ # Need this so that if giftopnm dies, we don't die.
+ $SIG{PIPE} = 'IGNORE';
}
+END { exit_cleanup(); }
+
# returns the full path of the named program, or undef.
#
-sub which {
+sub which($) {
my ($prog) = @_;
foreach (split (/:/, $ENV{PATH})) {
if (-x "$_/$prog") {
# Choose random foreground and background colors
#
-sub randcolors {
+sub randcolors() {
return sprintf ("#%02x%02x%02x-#%02x%02x%02x",
int(rand()*60),
int(rand()*60),
}
-sub filter_subst {
+
+sub filter_subst($$$@) {
my ($filter, $width, $height, @tmpfiles) = @_;
my $colors = randcolors();
$filter =~ s/\bWIDTH\b/$width/g;
$i++;
}
if ($filter =~ m/([A-Z]+)/) {
- error "internal error: what is \"$1\"?";
+ error ("internal error: what is \"$1\"?");
}
$filter =~ s/ +/ /g;
return $filter;
# Frobnicate the image in some random way.
#
-sub frob_ppm {
+sub frob_ppm($) {
my ($ppm_data) = @_;
$_ = $ppm_data;
- error "0-length data" if (!defined($ppm_data) || $ppm_data eq "");
- error "not a PPM file" unless (m/^P\d\n/s);
+ error ("0-length data") if (!defined($ppm_data) || $ppm_data eq "");
+ error ("not a PPM file") unless (m/^P\d\n/s);
my ($width, $height) = m/^P\d\n(\d+) (\d+)\n/s;
- error "got a bogus PPM" unless ($width && $height);
+ error ("got a bogus PPM") unless ($width && $height);
my $tmpdir = $ENV{TMPDIR};
$tmpdir = "/tmp" unless $tmpdir;
- my $fn = sprintf("$tmpdir/vw.%04x", $$);
- my @files = ( "$fn", "$fn.1", "$fn.2", "$fn.3" );
+ my $fn = sprintf ("%s/vidwhacker-0-%08x", $tmpdir, rand(0xFFFFFFFF));
+ my $fn1 = sprintf ("%s/vidwhacker-1-%08x", $tmpdir, rand(0xFFFFFFFF));
+ my $fn2 = sprintf ("%s/vidwhacker-2-%08x", $tmpdir, rand(0xFFFFFFFF));
+ my $fn3 = sprintf ("%s/vidwhacker-3-%08x", $tmpdir, rand(0xFFFFFFFF));
+ my @files = ( "$fn", "$fn1", "$fn2", "$fn3" );
+ push @all_tmpfiles, @files;
my $n = int(rand($#filters+1));
my $filter = $filters[$n];
}
-sub read_config {
+sub read_config() {
my $conf = "$ENV{HOME}/.xscreensaver";
my $had_dir = defined($imagedir);
local *IN;
- open (IN, "<$conf") || error "reading $conf: $!";
+ open (IN, "<$conf") || error ("reading $conf: $!");
while (<IN>) {
if (!$imagedir && m/^imageDirectory:\s+(.*)\s*$/i) { $imagedir = $1; }
elsif (m/^grabVideoFrames:\s+true\s*$/i) { $video_p = 1; }
$imagedir = undef unless ($imagedir && $imagedir ne '');
if (!$file_p && !$video_p) {
-# error "neither grabVideoFrames nor chooseRandomImages are set\n\t" .
+# error ("neither grabVideoFrames nor chooseRandomImages are set\n\t") .
# "in $conf; $progname requires one or both."
$file_p = 1;
}
if ($file_p) {
- error "no imageDirectory set in $conf" unless $imagedir;
- error "imageDirectory $imagedir doesn't exist" unless (-d $imagedir);
+ error ("no imageDirectory set in $conf") unless $imagedir;
+ error ("imageDirectory $imagedir doesn't exist") unless (-d $imagedir);
}
if ($verbose > 1) {
}
-sub get_ppm {
+sub get_ppm() {
if ($use_stdin) {
print STDERR "$progname: reading from stdin\n" if ($verbose > 1);
my $ppm = "";
elsif ($file_p) { $do_file_p = 1; }
elsif ($video_p) { $do_file_p = 0; }
else {
- error "internal error: not grabbing files or video?";
+ error ("internal error: not grabbing files or video?");
}
my $v = ($verbose <= 1 ? "" : "-" . ("v" x ($verbose-1)));
print STDERR "$progname: running: $cmd\n" if ($verbose > 1);
my $fn = `$cmd`;
$fn =~ s/\n$//s;
- error "didn't get a file?" if ($fn eq "");
+ error ("didn't get a file?") if ($fn eq "");
print STDERR "$progname: selected file $fn\n" if ($verbose > 1);
elsif ($fn =~ m/\.tiff?/i) { $cmd = "tifftopnm < \"$fn\""; }
elsif ($fn =~ m/\.p[bgp]m/i) { return `cat \"$fn\"`; }
else {
- error "unrecognized file extension on $fn";
+ print STDERR "$progname: $fn: unrecognized file extension\n";
+ # go around the loop and get another
+ return undef;
}
print STDERR "$progname: converting with: $cmd\n" if ($verbose > 1);
print STDERR "$progname: running: $cmd\n" if ($verbose > 1);
$ppm = `$cmd`;
- error "no data?" if ($ppm eq "");
- error "not a PPM file" unless ($ppm =~ m/^P\d\n/s);
+ error ("no data?") if ($ppm eq "");
+ error ("not a PPM file") unless ($ppm =~ m/^P\d\n/s);
$_ = $ppm;
my ($width, $height) = m/^P\d\n(\d+) (\d+)\n/s;
- error "got a bogus PPM" unless ($width && $height);
+ error ("got a bogus PPM") unless ($width && $height);
print STDERR "$progname: grabbed ${width}x$height PPM\n"
if ($verbose > 1);
$_ = 0;
}
}
-sub dispose_ppm {
+sub dispose_ppm($) {
my ($ppm) = @_;
- error "0-length data" if (!defined($ppm) || $ppm eq "");
- error "not a PPM file" unless ($ppm =~ m/^P\d\n/s);
+ error ("0-length data") if (!defined($ppm) || $ppm eq "");
+ error ("not a PPM file") unless ($ppm =~ m/^P\d\n/s);
if ($use_stdout) {
print STDERR "$progname: writing to stdout\n" if ($verbose > 1);
print $ppm;
} else {
- my $displayer = pick_displayer();
-
my $tmpdir = $ENV{TMPDIR};
$tmpdir = "/tmp" unless $tmpdir;
- my $fn = sprintf("$tmpdir/vw.%04x", $$);
+ my $fn = sprintf ("%s/vidwhacker-%08x", $tmpdir, rand(0xFFFFFFFF));
local *OUT;
unlink $fn;
- open (OUT, ">$fn") || error "writing $fn: $!";
+ push @all_tmpfiles, $fn;
+ open (OUT, ">$fn") || error ("writing $fn: $!");
print OUT $ppm;
close OUT;
if ($verbose);
system (@cmd);
+ my $exit_value = $? >> 8;
+ my $signal_num = $? & 127;
+ my $dumped_core = $? & 128;
+
unlink $fn;
+
+ error ("$cmd[0]: core dumped!") if ($dumped_core);
+ error ("$cmd[0]: signal $signal_num!") if ($signal_num);
+ error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
}
}
my $stdin_ppm = undef;
-sub vidwhack {
+sub vidwhack() {
my $ppm;
if ($use_stdin) {
if (!defined($stdin_ppm)) {
}
-sub usage {
+sub error($) {
+ my ($err) = @_;
+ print STDERR "$progname: $err\n";
+ exit 1;
+}
+
+sub usage() {
print STDERR "VidWhacker, Copyright (c) 2001 Jamie Zawinski <jwz\@jwz.org>\n";
print STDERR " http://www.jwz.org/xscreensaver/";
print STDERR "\n";
- print STDERR "usage: $0 [-display dpy] [-verbose] [-root | -window]\n";
- print STDERR " [-stdin] [-stdout] [-delay secs]\n";
- print STDERR " [-directory image_directory]\n";
+ print STDERR "usage: $0 [-display dpy] [-verbose]\n";
+ print STDERR "\t\t[-root | -window | -window-id 0xXXXXX ]\n";
+ print STDERR "\t\t[-stdin] [-stdout] [-delay secs]\n";
+ print STDERR "\t\t[-directory image_directory]\n";
exit 1;
}
-sub main {
+sub main() {
while ($_ = $ARGV[0]) {
shift @ARGV;
if ($_ eq "--verbose") { $verbose++; }
elsif (m/^--?delay$/) { $delay = shift @ARGV; }
elsif (m/^--?dir(ectory)?$/) { $imagedir = shift @ARGV; }
elsif (m/^--?root$/) { }
+ elsif (m/^--?window-id$/) {
+ my $id = shift @ARGV;
+ error ("unparsable window id: $id")
+ unless ($id =~ m/^\d+$|^0x[\da-f]+$/i);
+ $displayer =~ s/--?root\b/$id/ ||
+ error ("unable to munge displayer: $displayer");
+ }
elsif (m/^--?window$/) {
print STDERR "$progname: sorry, \"-window\" is unimplemented.\n";
print STDERR "$progname: use \"-stdout\" and pipe to a displayer.\n";
else { usage; }
}
+ init_signals();
+
read_config;
+ # sanity checking - is pbm installed?
+ # (this is a non-exhaustive but representative list)
+ foreach ("ppmtopgm", "pgmenhance", "pnminvert", "pnmarith", "pnmdepth") {
+ which ($_) || error "$_ not found on \$PATH.";
+ }
+
if (!$use_stdout) {
$_ = `xdpyinfo 2>&-`;
($screen_width) =~ m/ dimensions: +(\d+)x(\d+) pixels/;
}
}
-main;
+main();
exit 0;
projects / xscreensaver / blobdiff