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

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