9646f6bd95dd67ca61fdf9acc4897f0854dbddcb
[xscreensaver] / 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;