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

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