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

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