git.hungrycats.org Git - xscreensaver/blob - hacks/vidwhacker

   1 #!/usr/bin/perl -w
   2 # vidwhacker, for xscreensaver.  Copyright (c) 1998-2011 Jamie Zawinski.
   3 #
   4 # Permission to use, copy, modify, distribute, and sell this software and its
   5 # documentation for any purpose is hereby granted without fee, provided that
   6 # the above copyright notice appear in all copies and that both that
   7 # copyright notice and this permission notice appear in supporting
   8 # documentation.  No representations are made about the suitability of this
   9 # software for any purpose.  It is provided "as is" without express or
  10 # implied warranty.
  11 #
  12 # This program grabs a frame of video, then uses various pbm filters to
  13 # munge the image in random nefarious ways, then uses xloadimage, xli, or xv
  14 # to put it on the root window.  This works out really nicely if you just
  15 # feed some random TV station into it...
  16 #
  17 # Created: 14-Apr-01.
  18
  19 require 5;
  20 use diagnostics;
  21 use strict;
  22
  23 my $progname = $0; $progname =~ s@.*/@@g;
  24 my ($version) = ('$Revision: 1.33 $' =~ m/\s(\d[.\d]+)\s/s);
  25
  26 my $verbose = 0;
  27 my $use_stdin = 0;
  28 my $use_stdout = 0;
  29 my $video_p = 0;
  30 my $file_p = 1;
  31 my $delay = 5;
  32 my $imagedir;
  33
  34 my $screen_width = -1;
  35
  36 my $displayer = "xscreensaver-getimage -root -file";
  37
  38 sub which($);
  39
  40 # apparently some versions of netpbm call it "pamoil" instead of "pgmoil"...
  41 #
  42 my $pgmoil = (which("pamoil") ? "pamoil" : "pgmoil");
  43
  44
  45 # List of interesting PPM filter pipelines.
  46 # In this list, the following magic words may be used:
  47 #
  48 #  COLORS       a randomly-selected pair of RGB foreground/background colors.
  49 #  FILE1        the (already-existing) input PPM file (ok to overwrite it).
  50 #  FILE2-FILE4  names of other tmp files you can use.
  51 #
  52 # These commands should read from FILE1, and write to stdout.
  53 # All tmp files will be deleted afterward.
  54 #
  55 my @filters = (
  56   "ppmtopgm FILE1 | pgmedge | pgmtoppm COLORS | ppmnorm",
  57   "ppmtopgm FILE1 | pgmenhance | pgmtoppm COLORS",
  58   "ppmtopgm FILE1 | $pgmoil | pgmtoppm COLORS",
  59   "ppmtopgm FILE1 | pgmbentley | pgmtoppm COLORS",
  60
  61   "ppmrelief FILE1 | ppmtopgm | pgmedge | ppmrelief | ppmtopgm |" .
  62    " pgmedge | pnminvert | pgmtoppm COLORS",
  63
  64   "ppmspread 71 FILE1 > FILE2 ; " .
  65   " pnmarith -add FILE1 FILE2 ; ",
  66
  67   "pnmflip -lr < FILE1 > FILE2 ; " .
  68   " pnmarith -multiply FILE1 FILE2 > FILE3 ; " .
  69   " pnmflip -tb FILE3 | ppmnorm > FILE2 ; " .
  70   " pnmarith -multiply FILE1 FILE2",
  71
  72   "pnmflip -lr FILE1 > FILE2 ; " .
  73   " pnmarith -difference FILE1 FILE2",
  74
  75   "pnmflip -tb FILE1 > FILE2 ; " .
  76   " pnmarith -difference FILE1 FILE2",
  77
  78   "pnmflip -lr FILE1 | pnmflip -tb > FILE2 ; " .
  79   " pnmarith -difference FILE1 FILE2",
  80
  81   "ppmtopgm < FILE1 | pgmedge > FILE2 ; " .
  82   " pnmarith -difference FILE1 FILE2 > FILE3 ; " .
  83   " cp FILE3 FILE1 ; " .
  84   " ppmtopgm < FILE1 | pgmedge > FILE2 ; " .
  85   " pnmarith -difference FILE1 FILE2 > FILE3 ; " .
  86   " ppmnorm < FILE1",
  87
  88   "pnmflip -lr < FILE1 > FILE2 ; " .
  89   " pnmarith -multiply FILE1 FILE2 | ppmrelief | ppmnorm | pnminvert",
  90
  91   "pnmflip -lr FILE1 > FILE2 ; " .
  92   " pnmarith -subtract FILE1 FILE2 | ppmrelief | ppmtopgm | pgmedge",
  93
  94   "pgmcrater -number 20000 -width WIDTH -height HEIGHT FILE1 | " .
  95   "   pgmtoppm COLORS > FILE2 ; " .
  96   " pnmarith -difference FILE1 FILE2 > FILE3 ; " .
  97   " pnmflip -tb FILE3 | ppmnorm > FILE2 ; " .
  98   " pnmarith -multiply FILE1 FILE2",
  99
 100   "ppmshift 30 FILE1 | ppmtopgm | $pgmoil | pgmedge | " .
 101   "   pgmtoppm COLORS > FILE2 ; " .
 102   " pnmarith -difference FILE1 FILE2",
 103
 104   "ppmpat -madras WIDTH HEIGHT | pnmdepth 255 > FILE2 ; " .
 105   " pnmarith -difference FILE1 FILE2",
 106
 107   "ppmpat -tartan WIDTH HEIGHT | pnmdepth 255 > FILE2 ; " .
 108   " pnmarith -difference FILE1 FILE2",
 109
 110   "ppmpat -camo WIDTH HEIGHT | pnmdepth 255 | ppmshift 50 > FILE2 ; " .
 111   " pnmarith -multiply FILE1 FILE2",
 112
 113   "pgmnoise WIDTH HEIGHT | pgmedge | pgmtoppm COLORS > FILE2 ; " .
 114   " pnmarith -difference FILE1 FILE2 | pnmdepth 255 | pnmsmooth",
 115 );
 116
 117
 118 # Any files on this list will be deleted at exit.
 119 #
 120 my @all_tmpfiles = ();
 121
 122 sub exit_cleanup() {
 123   print STDERR "$progname: delete tmp files\n" if ($verbose);
 124   unlink @all_tmpfiles;
 125 }
 126
 127 sub signal_cleanup() {
 128   my ($sig) = @_;
 129   print STDERR "$progname: caught SIG$sig\n" if ($verbose);
 130   exit 1;
 131 }
 132
 133 sub init_signals() {
 134
 135   $SIG{HUP}  = \&signal_cleanup;
 136   $SIG{INT}  = \&signal_cleanup;
 137   $SIG{QUIT} = \&signal_cleanup;
 138   $SIG{ABRT} = \&signal_cleanup;
 139   $SIG{KILL} = \&signal_cleanup;
 140   $SIG{TERM} = \&signal_cleanup;
 141
 142   # Need this so that if giftopnm dies, we don't die.
 143   $SIG{PIPE} = 'IGNORE';
 144 }
 145
 146 END { exit_cleanup(); }
 147
 148
 149 # returns the full path of the named program, or undef.
 150 #
 151 sub which($) {
 152   my ($prog) = @_;
 153   foreach (split (/:/, $ENV{PATH})) {
 154     if (-x "$_/$prog") {
 155       return $prog;
 156     }
 157   }
 158   return undef;
 159 }
 160
 161
 162 # Choose random foreground and background colors
 163 #
 164 sub randcolors() {
 165   return sprintf ("#%02x%02x%02x-#%02x%02x%02x",
 166                   int(rand()*60),
 167                   int(rand()*60),
 168                   int(rand()*60),
 169                   120+int(rand()*135),
 170                   120+int(rand()*135),
 171                   120+int(rand()*135));
 172 }
 173
 174
 175
 176 sub filter_subst($$$@) {
 177   my ($filter, $width, $height, @tmpfiles) = @_;
 178   my $colors = randcolors();
 179   $filter =~ s/\bWIDTH\b/$width/g;
 180   $filter =~ s/\bHEIGHT\b/$height/g;
 181   $filter =~ s/\bCOLORS\b/'$colors'/g;
 182   my $i = 1;
 183   foreach my $t (@tmpfiles) {
 184     $filter =~ s/\bFILE$i\b/$t/g;
 185     $i++;
 186   }
 187   if ($filter =~ m/([A-Z]+)/) {
 188     error ("internal error: what is \"$1\"?");
 189   }
 190   $filter =~ s/  +/ /g;
 191   return $filter;
 192 }
 193
 194 # Frobnicate the image in some random way.
 195 #
 196 sub frob_ppm($) {
 197   my ($ppm_data) = @_;
 198   $_ = $ppm_data;
 199
 200   error ("0-length data") if (!defined($ppm_data) || $ppm_data eq  "");
 201   error ("not a PPM file") unless (m/^P\d\n/s);
 202   my ($width, $height) = m/^P\d\n(\d+) (\d+)\n/s;
 203   error ("got a bogus PPM") unless ($width && $height);
 204
 205   my $tmpdir = $ENV{TMPDIR};
 206   $tmpdir = "/tmp" unless $tmpdir;
 207   my $fn =  sprintf ("%s/vidwhacker-0-%08x", $tmpdir, rand(0xFFFFFFFF));
 208   my $fn1 = sprintf ("%s/vidwhacker-1-%08x", $tmpdir, rand(0xFFFFFFFF));
 209   my $fn2 = sprintf ("%s/vidwhacker-2-%08x", $tmpdir, rand(0xFFFFFFFF));
 210   my $fn3 = sprintf ("%s/vidwhacker-3-%08x", $tmpdir, rand(0xFFFFFFFF));
 211   my @files = ( "$fn", "$fn1", "$fn2", "$fn3" );
 212   push @all_tmpfiles, @files;
 213
 214   my $n = int(rand($#filters+1));
 215   my $filter = $filters[$n];
 216
 217   if ($verbose == 1) {
 218     printf STDERR "$progname: running filter $n\n";
 219   } elsif ($verbose > 1) {
 220     my $f = $filter;
 221     $f =~ s/  +/ /g;
 222     $f =~ s/^ */\t/;
 223     $f =~ s/ *\|/\n\t|/g;
 224     $f =~ s/ *\; */ ;\n\t/g;
 225     print STDERR "$progname: filter $n:\n\n$f\n\n" if $verbose;
 226   }
 227
 228   $filter = filter_subst ($filter, $width, $height, @files);
 229
 230   unlink @files;
 231
 232   local *OUT;
 233   open (OUT, ">$files[0]") || error ("writing $files[0]: $!");
 234   print OUT $ppm_data;
 235   close OUT;
 236
 237   $filter = "( $filter )";
 238   $filter .= "2>/dev/null" unless ($verbose > 1);
 239
 240   local *IN;
 241   open (IN, "$filter |") || error ("opening pipe: $!");
 242   $ppm_data = "";
 243   while (<IN>) { $ppm_data .= $_; }
 244   close IN;
 245
 246   unlink @files;
 247   return $ppm_data;
 248 }
 249
 250
 251 sub read_config() {
 252   my $conf = "$ENV{HOME}/.xscreensaver";
 253
 254   my $had_dir = defined($imagedir);
 255
 256   local *IN;
 257   open (IN, "<$conf") ||  error ("reading $conf: $!");
 258   while (<IN>) {
 259     if (!$imagedir && m/^imageDirectory:\s+(.*)\s*$/i) { $imagedir = $1; }
 260     elsif (m/^grabVideoFrames:\s+true\s*$/i)     { $video_p = 1; }
 261     elsif (m/^grabVideoFrames:\s+false\s*$/i)    { $video_p = 0; }
 262     elsif (m/^chooseRandomImages:\s+true\s*$/i)  { $file_p  = 1; }
 263     elsif (m/^chooseRandomImages:\s+false\s*$/i) { $file_p  = 0; }
 264   }
 265   close IN;
 266
 267   $file_p = 1 if $had_dir;
 268
 269   $imagedir = undef unless ($imagedir && $imagedir ne '');
 270
 271   if (!$file_p && !$video_p) {
 272 #    error ("neither grabVideoFrames nor chooseRandomImages are set\n\t") .
 273 #      "in $conf; $progname requires one or both."
 274     $file_p = 1;
 275   }
 276
 277   if ($file_p) {
 278     error ("no imageDirectory set in $conf") unless $imagedir;
 279     error ("imageDirectory $imagedir doesn't exist") unless (-d $imagedir);
 280   }
 281
 282   if ($verbose > 1) {
 283     printf STDERR "$progname: grab video: $video_p\n";
 284     printf STDERR "$progname: grab images: $file_p\n";
 285     printf STDERR "$progname: directory: $imagedir\n";
 286   }
 287
 288 }
 289
 290
 291 sub get_ppm() {
 292   if ($use_stdin) {
 293     print STDERR "$progname: reading from stdin\n" if ($verbose > 1);
 294     my $ppm = "";
 295     while (<STDIN>) { $ppm .= $_; }
 296     return $ppm;
 297
 298   } else {
 299
 300     my $do_file_p;
 301
 302     if ($file_p && $video_p) {
 303       $do_file_p = (int(rand(2)) == 0);
 304       print STDERR "$progname: doing " . ($do_file_p ? "files" : "video") ."\n"
 305         if ($verbose);
 306     }
 307     elsif ($file_p)  { $do_file_p = 1; }
 308     elsif ($video_p) { $do_file_p = 0; }
 309     else {
 310       error ("internal error: not grabbing files or video?");
 311     }
 312
 313     my $v = ($verbose <= 1 ? "" : "-" . ("v" x ($verbose-1)));
 314     my $cmd;
 315     if ($do_file_p) {
 316       $cmd = "xscreensaver-getimage-file  $v --name \"$imagedir\"";
 317     } else {
 318       $cmd = "xscreensaver-getimage-video $v --stdout";
 319     }
 320
 321     my $ppm;
 322
 323     if ($do_file_p) {
 324
 325       print STDERR "$progname: running: $cmd\n" if ($verbose > 1);
 326       my $fn = `$cmd`;
 327       $fn =~ s/\n$//s;
 328       error ("didn't get a file?") if ($fn eq "");
 329       $fn = "$imagedir/$fn" unless ($fn =~ m@^/@s);
 330
 331       print STDERR "$progname: selected file $fn\n" if ($verbose > 1);
 332
 333       if    ($fn =~ m/\.gif/i)   { $cmd = "giftopnm < \"$fn\""; }
 334       elsif ($fn =~ m/\.jpe?g/i) { $cmd = "djpeg < \"$fn\""; }
 335       elsif ($fn =~ m/\.png/i)   { $cmd = "pngtopnm < \"$fn\""; }
 336       elsif ($fn =~ m/\.xpm/i)   { $cmd = "xpmtoppm < \"$fn\""; }
 337       elsif ($fn =~ m/\.bmp/i)   { $cmd = "bmptoppm < \"$fn\""; }
 338       elsif ($fn =~ m/\.tiff?/i) { $cmd = "tifftopnm < \"$fn\""; }
 339       elsif ($fn =~ m/\.p[bgp]m/i) { return `cat \"$fn\"`; }
 340       else {
 341         print STDERR "$progname: $fn: unrecognized file extension\n";
 342         # go around the loop and get another
 343         return undef;
 344       }
 345
 346       print STDERR "$progname: converting with: $cmd\n" if ($verbose > 1);
 347       $cmd .= " 2>/dev/null" unless ($verbose > 1);
 348       $ppm = `$cmd`;
 349
 350     } else {
 351
 352       print STDERR "$progname: running: $cmd\n" if ($verbose > 1);
 353       $ppm = `$cmd`;
 354       error ("no data?") if ($ppm eq "");
 355       error ("not a PPM file") unless ($ppm =~ m/^P\d\n/s);
 356
 357       $_ = $ppm;
 358       my ($width, $height) = m/^P\d\n(\d+) (\d+)\n/s;
 359       error ("got a bogus PPM") unless ($width && $height);
 360       print STDERR "$progname: grabbed ${width}x$height PPM\n"
 361         if ($verbose > 1);
 362       $_ = 0;
 363     }
 364
 365     return $ppm;
 366   }
 367 }
 368
 369 sub dispose_ppm($) {
 370   my ($ppm) = @_;
 371
 372   error ("0-length data") if (!defined($ppm) || $ppm eq  "");
 373   error ("not a PPM file") unless ($ppm =~ m/^P\d\n/s);
 374
 375   if ($use_stdout) {
 376     print STDERR "$progname: writing to stdout\n" if ($verbose > 1);
 377     print $ppm;
 378
 379   } else {
 380     my $tmpdir = $ENV{TMPDIR};
 381     $tmpdir = "/tmp" unless $tmpdir;
 382     my $fn =  sprintf ("%s/vidwhacker-%08x.ppm", $tmpdir, rand(0xFFFFFFFF));
 383     local *OUT;
 384     unlink $fn;
 385     push @all_tmpfiles, $fn;
 386     open (OUT, ">$fn") || error ("writing $fn: $!");
 387     print OUT $ppm;
 388     close OUT;
 389
 390     my @cmd = split (/ +/, $displayer);
 391     push @cmd, $fn;
 392     print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
 393       if ($verbose);
 394     system (@cmd);
 395
 396     my $exit_value  = $? >> 8;
 397     my $signal_num  = $? & 127;
 398     my $dumped_core = $? & 128;
 399
 400     unlink $fn;
 401
 402     error ("$cmd[0]: core dumped!") if ($dumped_core);
 403     error ("$cmd[0]: signal $signal_num!") if ($signal_num);
 404     error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
 405   }
 406 }
 407
 408
 409 my $stdin_ppm = undef;
 410
 411 sub vidwhack() {
 412   my $ppm;
 413   if ($use_stdin) {
 414     if (!defined($stdin_ppm)) {
 415       $stdin_ppm = get_ppm();
 416     }
 417     $ppm = $stdin_ppm;
 418   } else {
 419     my $max_err_count = 20;
 420     my $err_count = 0;
 421     while (!defined($ppm)) {
 422       $ppm = get_ppm();
 423       $err_count++ if (!defined ($ppm));
 424       error ("too many errors, too few images!")
 425         if ($err_count > $max_err_count);
 426     }
 427   }
 428
 429   $ppm = frob_ppm ($ppm);
 430   dispose_ppm ($ppm);
 431   $ppm = undef;
 432 }
 433
 434
 435 sub error($) {
 436   my ($err) = @_;
 437   print STDERR "$progname: $err\n";
 438   exit 1;
 439 }
 440
 441 sub usage() {
 442   print STDERR "VidWhacker, Copyright (c) 2001 Jamie Zawinski <jwz\@jwz.org>\n";
 443   print STDERR "            https://www.jwz.org/xscreensaver/";
 444   print STDERR "\n";
 445   print STDERR "usage: $0 [-display dpy] [-verbose]\n";
 446   print STDERR "\t\t[-root | -window | -window-id 0xXXXXX ]\n";
 447   print STDERR "\t\t[-stdin] [-stdout] [-delay secs]\n";
 448   print STDERR "\t\t[-directory image_directory]\n";
 449   exit 1;
 450 }
 451
 452 sub main() {
 453   while ($_ = $ARGV[0]) {
 454     shift @ARGV;
 455     if (m/^--?verbose$/) { $verbose++; }
 456     elsif (m/^-v+$/) { $verbose += length($_)-1; }
 457     elsif (m/^(-display|-disp|-dis|-dpy|-d)$/) { $ENV{DISPLAY} = shift @ARGV; }
 458     elsif (m/^--?stdin$/) { $use_stdin = 1; }
 459     elsif (m/^--?stdout$/) { $use_stdout = 1; }
 460     elsif (m/^--?delay$/) { $delay = shift @ARGV; }
 461     elsif (m/^--?dir(ectory)?$/) { $imagedir = shift @ARGV; }
 462     elsif (m/^--?root$/) { }
 463     elsif (m/^--?window-id$/) {
 464       my $id = shift @ARGV;
 465       error ("unparsable window id: $id")
 466         unless ($id =~ m/^\d+$|^0x[\da-f]+$/i);
 467       $displayer =~ s/--?root\b/$id/ ||
 468         error ("unable to munge displayer: $displayer");
 469     }
 470     elsif (m/^--?window$/) {
 471       print STDERR "$progname: sorry, \"-window\" is unimplemented.\n";
 472       print STDERR "$progname: use \"-stdout\" and pipe to a displayer.\n";
 473       exit 1;
 474     }
 475     elsif (m/^-./) { usage; }
 476     else { usage; }
 477   }
 478
 479   init_signals();
 480
 481   read_config;
 482
 483   # sanity checking - is pbm installed?
 484   # (this is a non-exhaustive but representative list)
 485   foreach ("ppmtopgm", "pgmenhance", "pnminvert", "pnmarith", "pnmdepth") {
 486     which ($_) || error "$_ not found on \$PATH.";
 487   }
 488
 489   if (!$use_stdout) {
 490     $_ = `xdpyinfo 2>&-`;
 491     ($screen_width) =~ m/ dimensions: +(\d+)x(\d+) pixels/;
 492     $screen_width = 800 unless $screen_width > 0;
 493   }
 494
 495   if ($use_stdout) {
 496     vidwhack();
 497   } else {
 498     while (1) {
 499       vidwhack();
 500       sleep $delay;
 501     }
 502   }
 503 }
 504
 505 main();
 506 exit 0;