ftp://ftp.krokus.ru/pub/OpenBSD/distfiles/xscreensaver-5.01.tar.gz
[xscreensaver] / hacks / vidwhacker
index 8308cccac8236abd0d961c259c9106b546be1e4e..1496495120833e4d54e7e3c931f1e2255cfdef17 100755 (executable)
@@ -1,5 +1,5 @@
 #!/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
@@ -21,7 +21,7 @@ use diagnostics;
 use strict;
 
 my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.19 $ }; $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;
@@ -33,26 +33,13 @@ my $imagedir;
 
 my $screen_width = -1;
 
+my $displayer = "xscreensaver-getimage -root -file";
 
+sub which($);
 
-# ####  This list was lifted from driver/xscreensaver-getimage-file
+# apparently some versions of netpbm call it "pamoil" instead of "pgmoil"...
 #
-# 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",
-);
+my $pgmoil = (which("pamoil") ? "pamoil" : "pgmoil");
 
 
 # List of interesting PPM filter pipelines.
@@ -68,7 +55,7 @@ my @displayer_programs = (
 my @filters = (
   "ppmtopgm FILE1 | pgmedge | pgmtoppm COLORS | ppmnorm",
   "ppmtopgm FILE1 | pgmenhance | pgmtoppm COLORS",
-  "ppmtopgm FILE1 | pgmoil | pgmtoppm COLORS",
+  "ppmtopgm FILE1 | $pgmoil | pgmtoppm COLORS",
   "ppmtopgm FILE1 | pgmbentley | pgmtoppm COLORS",
 
   "ppmrelief FILE1 | ppmtopgm | pgmedge | ppmrelief | ppmtopgm |" .
@@ -110,7 +97,7 @@ my @filters = (
   " pnmflip -tb FILE3 | ppmnorm > FILE2 ; " .
   " pnmarith -multiply FILE1 FILE2",
 
-  "ppmshift 30 FILE1 | ppmtopgm | pgmoil | pgmedge | " .
+  "ppmshift 30 FILE1 | ppmtopgm | $pgmoil | pgmedge | " .
   "   pgmtoppm COLORS > FILE2 ; " .
   " pnmarith -difference FILE1 FILE2",
 
@@ -128,38 +115,53 @@ my @filters = (
 );
 
 
-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 init_signals() {
+
+  $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 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 which($) {
+  my ($prog) = @_;
+  foreach (split (/:/, $ENV{PATH})) {
+    if (-x "$_/$prog") {
+      return $prog;
     }
   }
-
-  $names[$#names] = "or " . $names[$#names];
-  printf STDERR "$progname: none of: " . join (", ", @names) .
-                " were found on \$PATH.\n";
-  exit 1;
+  return undef;
 }
 
 
 # Choose random foreground and background colors
 #
-sub randcolors {
+sub randcolors() {
   return sprintf ("#%02x%02x%02x-#%02x%02x%02x",
                   int(rand()*60),
                   int(rand()*60),
@@ -170,7 +172,8 @@ sub randcolors {
 }
 
 
-sub filter_subst {
+
+sub filter_subst($$$@) {
   my ($filter, $width, $height, @tmpfiles) = @_;
   my $colors = randcolors();
   $filter =~ s/\bWIDTH\b/$width/g;
@@ -182,7 +185,7 @@ sub filter_subst {
     $i++;
   }
   if ($filter =~ m/([A-Z]+)/) {
-    error "internal error: what is \"$1\"?";
+    error ("internal error: what is \"$1\"?");
   }
   $filter =~ s/  +/ /g;
   return $filter;
@@ -190,19 +193,23 @@ sub filter_subst {
 
 # 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];
@@ -241,13 +248,13 @@ sub frob_ppm {
 }
 
 
-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; }
@@ -262,14 +269,14 @@ sub read_config {
   $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) {
@@ -281,7 +288,7 @@ sub read_config {
 }
 
 
-sub get_ppm {
+sub get_ppm() {
   if ($use_stdin) {
     print STDERR "$progname: reading from stdin\n" if ($verbose > 1);
     my $ppm = "";
@@ -300,7 +307,7 @@ sub get_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)));
@@ -315,34 +322,40 @@ sub get_ppm {
 
     if ($do_file_p) {
 
-      print STDERR "$progname: running \"$cmd\"\n" if ($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);
 
       if    ($fn =~ m/\.gif/i)   { $cmd = "giftopnm < \"$fn\""; }
       elsif ($fn =~ m/\.jpe?g/i) { $cmd = "djpeg < \"$fn\""; }
       elsif ($fn =~ m/\.png/i)   { $cmd = "pngtopnm < \"$fn\""; }
+      elsif ($fn =~ m/\.xpm/i)   { $cmd = "xpmtoppm < \"$fn\""; }
+      elsif ($fn =~ m/\.bmp/i)   { $cmd = "bmptoppm < \"$fn\""; }
+      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: converting with: $cmd\n" if ($verbose > 1);
       $cmd .= " 2>/dev/null" unless ($verbose > 1);
       $ppm = `$cmd`;
 
     } else {
 
-      print STDERR "$progname: running \"$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;
@@ -352,25 +365,24 @@ sub get_ppm {
   }
 }
 
-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;
 
@@ -380,14 +392,22 @@ sub dispose_ppm {
       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)) {
@@ -395,7 +415,14 @@ sub vidwhack {
     }
     $ppm = $stdin_ppm;
   } else {
-    $ppm = get_ppm();
+    my $max_err_count = 20;
+    my $err_count = 0;
+    while (!defined($ppm)) {
+      $ppm = get_ppm();
+      $err_count++ if (!defined ($ppm));
+      error ("too many errors, too few images!")
+        if ($err_count > $max_err_count);
+    }
   }
 
   $ppm = frob_ppm ($ppm);
@@ -404,17 +431,24 @@ sub vidwhack {
 }
 
 
-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++; }
@@ -425,6 +459,13 @@ sub main {
     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";
@@ -434,8 +475,16 @@ sub main {
     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/;
@@ -452,5 +501,5 @@ sub main {
   }
 }
 
-main;
+main();
 exit 0;