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.22 $ }; $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 # ####  Lifted from driver/xscreensaver-getimage-file
 143 #
 144 sub pick_displayer {
 145   my @names = ();
 146
 147   foreach my $cmd (@displayer_programs) {
 148     $_ = $cmd;
 149     my ($name) = m/^([^ ]+)/;
 150     push @names, "\"$name\"";
 151     print STDERR "$progname: looking for $name...\n" if ($verbose > 2);
 152     foreach my $dir (split (/:/, $ENV{PATH})) {
 153       print STDERR "$progname:   checking $dir/$name\n" if ($verbose > 3);
 154       return $cmd if (-x "$dir/$name");
 155     }
 156   }
 157
 158   $names[$#names] = "or " . $names[$#names];
 159   printf STDERR "$progname: none of: " . join (", ", @names) .
 160                 " were found on \$PATH.\n";
 161   exit 1;
 162 }
 163
 164
 165 # returns the full path of the named program, or undef.
 166 #
 167 sub which {
 168   my ($prog) = @_;
 169   foreach (split (/:/, $ENV{PATH})) {
 170     if (-x "$_/$prog") {
 171       return $prog;
 172     }
 173   }
 174   return undef;
 175 }
 176
 177
 178 # Choose random foreground and background colors
 179 #
 180 sub randcolors {
 181   return sprintf ("#%02x%02x%02x-#%02x%02x%02x",
 182                   int(rand()*60),
 183                   int(rand()*60),
 184                   int(rand()*60),
 185                   120+int(rand()*135),
 186                   120+int(rand()*135),
 187                   120+int(rand()*135));
 188 }
 189
 190
 191 sub filter_subst {
 192   my ($filter, $width, $height, @tmpfiles) = @_;
 193   my $colors = randcolors();
 194   $filter =~ s/\bWIDTH\b/$width/g;
 195   $filter =~ s/\bHEIGHT\b/$height/g;
 196   $filter =~ s/\bCOLORS\b/'$colors'/g;
 197   my $i = 1;
 198   foreach my $t (@tmpfiles) {
 199     $filter =~ s/\bFILE$i\b/$t/g;
 200     $i++;
 201   }
 202   if ($filter =~ m/([A-Z]+)/) {
 203     error "internal error: what is \"$1\"?";
 204   }
 205   $filter =~ s/  +/ /g;
 206   return $filter;
 207 }
 208
 209 # Frobnicate the image in some random way.
 210 #
 211 sub frob_ppm {
 212   my ($ppm_data) = @_;
 213   $_ = $ppm_data;
 214
 215   error "0-length data" if (!defined($ppm_data) || $ppm_data eq  "");
 216   error "not a PPM file" unless (m/^P\d\n/s);
 217   my ($width, $height) = m/^P\d\n(\d+) (\d+)\n/s;
 218   error "got a bogus PPM" unless ($width && $height);
 219
 220   my $tmpdir = $ENV{TMPDIR};
 221   $tmpdir = "/tmp" unless $tmpdir;
 222   my $fn = sprintf("$tmpdir/vw.%04x", $$);
 223   my @files = ( "$fn", "$fn.1", "$fn.2", "$fn.3" );
 224
 225   my $n = int(rand($#filters+1));
 226   my $filter = $filters[$n];
 227
 228   if ($verbose == 1) {
 229     printf STDERR "$progname: running filter $n\n";
 230   } elsif ($verbose > 1) {
 231     my $f = $filter;
 232     $f =~ s/  +/ /g;
 233     $f =~ s/^ */\t/;
 234     $f =~ s/ *\|/\n\t|/g;
 235     $f =~ s/ *\; */ ;\n\t/g;
 236     print STDERR "$progname: filter $n:\n\n$f\n\n" if $verbose;
 237   }
 238
 239   $filter = filter_subst ($filter, $width, $height, @files);
 240
 241   unlink @files;
 242
 243   local *OUT;
 244   open (OUT, ">$files[0]") || error ("writing $files[0]: $!");
 245   print OUT $ppm_data;
 246   close OUT;
 247
 248   $filter = "( $filter )";
 249   $filter .= "2>/dev/null" unless ($verbose > 1);
 250
 251   local *IN;
 252   open (IN, "$filter |") || error ("opening pipe: $!");
 253   $ppm_data = "";
 254   while (<IN>) { $ppm_data .= $_; }
 255   close IN;
 256
 257   unlink @files;
 258   return $ppm_data;
 259 }
 260
 261
 262 sub read_config {
 263   my $conf = "$ENV{HOME}/.xscreensaver";
 264
 265   my $had_dir = defined($imagedir);
 266
 267   local *IN;
 268   open (IN, "<$conf") ||  error "reading $conf: $!";
 269   while (<IN>) {
 270     if (!$imagedir && m/^imageDirectory:\s+(.*)\s*$/i) { $imagedir = $1; }
 271     elsif (m/^grabVideoFrames:\s+true\s*$/i)     { $video_p = 1; }
 272     elsif (m/^grabVideoFrames:\s+false\s*$/i)    { $video_p = 0; }
 273     elsif (m/^chooseRandomImages:\s+true\s*$/i)  { $file_p  = 1; }
 274     elsif (m/^chooseRandomImages:\s+false\s*$/i) { $file_p  = 0; }
 275   }
 276   close IN;
 277
 278   $file_p = 1 if $had_dir;
 279
 280   $imagedir = undef unless ($imagedir && $imagedir ne '');
 281
 282   if (!$file_p && !$video_p) {
 283 #    error "neither grabVideoFrames nor chooseRandomImages are set\n\t" .
 284 #      "in $conf; $progname requires one or both."
 285     $file_p = 1;
 286   }
 287
 288   if ($file_p) {
 289     error "no imageDirectory set in $conf" unless $imagedir;
 290     error "imageDirectory $imagedir doesn't exist" unless (-d $imagedir);
 291   }
 292
 293   if ($verbose > 1) {
 294     printf STDERR "$progname: grab video: $video_p\n";
 295     printf STDERR "$progname: grab images: $file_p\n";
 296     printf STDERR "$progname: directory: $imagedir\n";
 297   }
 298
 299 }
 300
 301
 302 sub get_ppm {
 303   if ($use_stdin) {
 304     print STDERR "$progname: reading from stdin\n" if ($verbose > 1);
 305     my $ppm = "";
 306     while (<STDIN>) { $ppm .= $_; }
 307     return $ppm;
 308
 309   } else {
 310
 311     my $do_file_p;
 312
 313     if ($file_p && $video_p) {
 314       $do_file_p = (int(rand(2)) == 0);
 315       print STDERR "$progname: doing " . ($do_file_p ? "files" : "video") ."\n"
 316         if ($verbose);
 317     }
 318     elsif ($file_p)  { $do_file_p = 1; }
 319     elsif ($video_p) { $do_file_p = 0; }
 320     else {
 321       error "internal error: not grabbing files or video?";
 322     }
 323
 324     my $v = ($verbose <= 1 ? "" : "-" . ("v" x ($verbose-1)));
 325     my $cmd;
 326     if ($do_file_p) {
 327       $cmd = "xscreensaver-getimage-file  $v --name \"$imagedir\"";
 328     } else {
 329       $cmd = "xscreensaver-getimage-video $v --stdout";
 330     }
 331
 332     my $ppm;
 333
 334     if ($do_file_p) {
 335
 336       print STDERR "$progname: running: $cmd\n" if ($verbose > 1);
 337       my $fn = `$cmd`;
 338       $fn =~ s/\n$//s;
 339       error "didn't get a file?" if ($fn eq "");
 340
 341       print STDERR "$progname: selected file $fn\n" if ($verbose > 1);
 342
 343       if    ($fn =~ m/\.gif/i)   { $cmd = "giftopnm < \"$fn\""; }
 344       elsif ($fn =~ m/\.jpe?g/i) { $cmd = "djpeg < \"$fn\""; }
 345       elsif ($fn =~ m/\.png/i)   { $cmd = "pngtopnm < \"$fn\""; }
 346       elsif ($fn =~ m/\.xpm/i)   { $cmd = "xpmtoppm < \"$fn\""; }
 347       elsif ($fn =~ m/\.bmp/i)   { $cmd = "bmptoppm < \"$fn\""; }
 348       elsif ($fn =~ m/\.tiff?/i) { $cmd = "tifftopnm < \"$fn\""; }
 349       elsif ($fn =~ m/\.p[bgp]m/i) { return `cat \"$fn\"`; }
 350       else {
 351         error "unrecognized file extension on $fn";
 352       }
 353
 354       print STDERR "$progname: converting with: $cmd\n" if ($verbose > 1);
 355       $cmd .= " 2>/dev/null" unless ($verbose > 1);
 356       $ppm = `$cmd`;
 357
 358     } else {
 359
 360       print STDERR "$progname: running: $cmd\n" if ($verbose > 1);
 361       $ppm = `$cmd`;
 362       error "no data?" if ($ppm eq "");
 363       error "not a PPM file" unless ($ppm =~ m/^P\d\n/s);
 364
 365       $_ = $ppm;
 366       my ($width, $height) = m/^P\d\n(\d+) (\d+)\n/s;
 367       error "got a bogus PPM" unless ($width && $height);
 368       print STDERR "$progname: grabbed ${width}x$height PPM\n"
 369         if ($verbose > 1);
 370       $_ = 0;
 371     }
 372
 373     return $ppm;
 374   }
 375 }
 376
 377 sub dispose_ppm {
 378   my ($ppm) = @_;
 379
 380   error "0-length data" if (!defined($ppm) || $ppm eq  "");
 381   error "not a PPM file" unless ($ppm =~ m/^P\d\n/s);
 382
 383   if ($use_stdout) {
 384     print STDERR "$progname: writing to stdout\n" if ($verbose > 1);
 385     print $ppm;
 386
 387   } else {
 388     my $displayer = pick_displayer();
 389
 390     my $tmpdir = $ENV{TMPDIR};
 391     $tmpdir = "/tmp" unless $tmpdir;
 392     my $fn = sprintf("$tmpdir/vw.%04x", $$);
 393     local *OUT;
 394     unlink $fn;
 395     open (OUT, ">$fn") || error "writing $fn: $!";
 396     print OUT $ppm;
 397     close OUT;
 398
 399     my @cmd = split (/ +/, $displayer);
 400     push @cmd, $fn;
 401     print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
 402       if ($verbose);
 403     system (@cmd);
 404
 405     unlink $fn;
 406   }
 407 }
 408
 409
 410 my $stdin_ppm = undef;
 411
 412 sub vidwhack {
 413   my $ppm;
 414   if ($use_stdin) {
 415     if (!defined($stdin_ppm)) {
 416       $stdin_ppm = get_ppm();
 417     }
 418     $ppm = $stdin_ppm;
 419   } else {
 420     my $max_err_count = 20;
 421     my $err_count = 0;
 422     while (!defined($ppm)) {
 423       $ppm = get_ppm();
 424       $err_count++ if (!defined ($ppm));
 425       error ("too many errors, too few images!")
 426         if ($err_count > $max_err_count);
 427     }
 428   }
 429
 430   $ppm = frob_ppm ($ppm);
 431   dispose_ppm ($ppm);
 432   $ppm = undef;
 433 }
 434
 435
 436 sub usage {
 437   print STDERR "VidWhacker, Copyright (c) 2001 Jamie Zawinski <jwz\@jwz.org>\n";
 438   print STDERR "            http://www.jwz.org/xscreensaver/";
 439   print STDERR "\n";
 440   print STDERR "usage: $0 [-display dpy] [-verbose] [-root | -window]\n";
 441   print STDERR "                  [-stdin] [-stdout] [-delay secs]\n";
 442   print STDERR "                  [-directory image_directory]\n";
 443   exit 1;
 444 }
 445
 446 sub main {
 447   while ($_ = $ARGV[0]) {
 448     shift @ARGV;
 449     if ($_ eq "--verbose") { $verbose++; }
 450     elsif (m/^-v+$/) { $verbose += length($_)-1; }
 451     elsif (m/^(-display|-disp|-dis|-dpy|-d)$/) { $ENV{DISPLAY} = shift @ARGV; }
 452     elsif (m/^--?stdin$/) { $use_stdin = 1; }
 453     elsif (m/^--?stdout$/) { $use_stdout = 1; }
 454     elsif (m/^--?delay$/) { $delay = shift @ARGV; }
 455     elsif (m/^--?dir(ectory)?$/) { $imagedir = shift @ARGV; }
 456     elsif (m/^--?root$/) { }
 457     elsif (m/^--?window$/) {
 458       print STDERR "$progname: sorry, \"-window\" is unimplemented.\n";
 459       print STDERR "$progname: use \"-stdout\" and pipe to a displayer.\n";
 460       exit 1;
 461     }
 462     elsif (m/^-./) { usage; }
 463     else { usage; }
 464   }
 465
 466   read_config;
 467
 468   if (!$use_stdout) {
 469     $_ = `xdpyinfo 2>&-`;
 470     ($screen_width) =~ m/ dimensions: +(\d+)x(\d+) pixels/;
 471     $screen_width = 800 unless $screen_width > 0;
 472   }
 473
 474   if ($use_stdout) {
 475     vidwhack();
 476   } else {
 477     while (1) {
 478       vidwhack();
 479       sleep $delay;
 480     }
 481   }
 482 }
 483
 484 main;
 485 exit 0;