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