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