#!/usr/bin/perl -w
#
-# webcollage, Copyright (c) 1999-2001 by Jamie Zawinski <jwz@jwz.org>
+# webcollage, Copyright (c) 1999-2002 by Jamie Zawinski <jwz@jwz.org>
# This program decorates the screen with random images from the web.
# One satisfied customer described it as "a nonstop pop culture brainbath."
#
my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.82 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
-my $copyright = "WebCollage $version, Copyright (c) 1999-2001" .
+my $version = q{ $Revision: 1.90 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $copyright = "WebCollage $version, Copyright (c) 1999-2002" .
" Jamie Zawinski <jwz\@jwz.org>\n" .
" http://www.jwz.org/xscreensaver/\n";
-my @search_methods = ( 30, "imagevista", \&pick_from_alta_vista_images,
- 28, "altavista", \&pick_from_alta_vista_text,
- 18, "yahoorand", \&pick_from_yahoo_random_link,
- 14, "googleimgs", \&pick_from_google_images,
+my @search_methods = ( 40, "imagevista", \&pick_from_alta_vista_images,
+ 30, "altavista", \&pick_from_alta_vista_text,
+ 19, "yahoorand", \&pick_from_yahoo_random_link,
+ 9, "lycos", \&pick_from_lycos_text,
2, "yahoonews", \&pick_from_yahoo_news_text,
- 8, "lycos", \&pick_from_lycos_text,
# Hotbot gives me "no matches" just about every time.
# Then I try the same URL again, and it works. I guess
# it caches searches, and webcollage always busts its
# cache and time out? Or it just sucks.
# 0, "hotbot", \&pick_from_hotbot_text,
- );
-#@search_methods=(100, "googleimgs",\&pick_from_google_images);
+ # Google asked (nicely) for me to stop searching them.
+ # 0, "googlenums", \&pick_from_google_image_numbers,
+ # 0, "googleimgs", \&pick_from_google_images,
+
+ );
# programs we can use to write to the root window (tried in ascending order.)
#
my @root_displayers = (
- "xloadimage -quiet -onroot -center -border black",
- "xli -quiet -onroot -center -border black",
- "xv -root -quit -viewonly +noresetroot -rmode 5" .
+ "chbg -once -xscreensaver -max_size 100",
+ "xv -root -quit -viewonly +noresetroot -quick24 -rmode 5" .
" -rfg black -rbg black",
- "chbg -once -xscreensaver",
+ "xli -quiet -onroot -center -border black",
+ "xloadimage -quiet -onroot -center -border black",
# this lame program wasn't built with vroot.h:
# "xsri -scale -keep-aspect -center-horizontal -center-vertical",
);
+# If this is set, it's a helper program to use for pasting images together:
+# this is a lot faster and more efficient than using PPM pipelines, which is
+# what we do if this program doesn't exist. (We check for "webcollage-helper"
+# on $PATH at startup, and set this variable appropriately.)
+#
+my $webcollage_helper = undef;
+
+
+# If we have the webcollage-helper program, then it will paste the images
+# together with transparency! 0.0 is invisible, 1.0 is totally opaque.
+#
+my $opacity = 0.85;
+
+
# Some sites have managed to poison the search engines. These are they.
# (We auto-detect sites that have poisoned the search engines via excessive
# keywords or dictionary words, but these are ones that slip through
"bartleby.com" => 1, # Dictionary, cluttering altavista.
"encyclopedia.com" => 1, # Dictionary, cluttering altavista.
"onlinedictionary.datasegment.com" => 1, # Dictionary, cluttering altavista.
+ "hotlinkpics.com" => 1, # Porn site that has poisoned imagevista
+ # (I don't see how they did it, though!)
+ "alwayshotels.com" => 1, # Poisoned Lycos pretty heavily.
);
LOG ($verbose_http, " ==> $_");
}
print S $hdrs;
- my $http = <S>;
+ my $http = <S> || "";
$_ = $http;
s/[\r\n]+$//s;
}
sub random_words {
- return (random_word . "%20" .
- random_word . "%20" .
- random_word . "%20" .
- random_word . "%20" .
+ my ($or_p) = @_;
+ my $sep = ($or_p ? "%20OR%20" : "%20");
+ return (random_word . $sep .
+ random_word . $sep .
+ random_word . $sep .
+ random_word . $sep .
random_word);
}
sub pick_from_alta_vista_images {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(1);
my $page = (int(rand(9)) + 1);
my $search_url = $alta_vista_images_url . $words;
\f
############################################################################
#
-# Pick images by feeding random words into Google Image Search
+# Pick images by feeding random words into Google Image Search.
# By Charles Gales <gales@us.ibm.com>
#
############################################################################
}
+\f
+############################################################################
+#
+# Pick images by feeding random *numbers* into Google Image Search.
+# By jwz, suggested by from Ian O'Donnell.
+#
+############################################################################
+
+
+# googlenums
+sub pick_from_google_image_numbers {
+ my ( $timeout ) = @_;
+
+ my $max = 9999;
+ my $number = int(rand($max));
+
+ $number = sprintf("%04d", $number)
+ if (rand() < 0.3);
+
+ my $words = "$number";
+ my $page = (int(rand(40)) + 1);
+ my $num = 20; # 20 images per page
+ my $search_url = $google_images_url . $words;
+
+ if ($page > 1) {
+ $search_url .= "&start=" . $page*$num; # page number
+ $search_url .= "&num=" . $num; #images per page
+ }
+
+ my ($search_hit_count, @subpages) =
+ pick_from_search_engine ($timeout, $search_url, $words);
+
+ my @candidates = ();
+ my %referers;
+ foreach my $u (@subpages) {
+ next unless ($u =~ m@imgres\?imgurl@i); # All pics start with this
+ next if ($u =~ m@[/.]google\.com\b@i); # skip google builtins
+
+ if ($u =~ m@^/imgres\?imgurl=(.*?)\&imgrefurl=(.*?)\&@) {
+ my $ref = $2;
+ my $img = "http://$1";
+
+ LOG ($verbose_filter, " candidate: $ref");
+ push @candidates, $img;
+ $referers{$img} = $ref;
+ }
+ }
+
+ @candidates = depoison (@candidates);
+ return () if ($#candidates < 0);
+ my $i = int(rand($#candidates+1));
+ my $img = $candidates[$i];
+ my $ref = $referers{$img};
+
+ LOG ($verbose_load, "picked image " . ($i+1) . ": $img (on $ref)");
+ return ($ref, $img);
+}
+
+
\f
############################################################################
#
sub pick_from_alta_vista_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(1);
my $page = (int(rand(9)) + 1);
my $search_url = $alta_vista_url . $words;
sub pick_from_hotbot_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(0);
my $search_url = $hotbot_search_url . $words;
my ($search_hit_count, @subpages) =
sub pick_from_lycos_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(0);
my $start = int(rand(8)) * 10 + 1;
my $search_url = $lycos_search_url . $words . "&start=$start";
sub pick_from_yahoo_news_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(1);
my $search_url = $yahoo_news_url . $words;
my ($search_hit_count, @subpages) =
my @candidates = ();
foreach my $u (@subpages) {
# only accept URLs on Yahoo's news site
- next unless ($u =~ m@^http://dailynews.yahoo.com/@i);
+ next unless ($u =~ m@^http://dailynews\.yahoo\.com/@i ||
+ $u =~ m@^http://story\.news\.yahoo\.com/@i);
LOG ($verbose_filter, " candidate: $u");
push @candidates, $u;
while (ord($ch) != 0xDA && $i < $L) {
# Find next marker, beginning with 0xFF.
while (ord($ch) != 0xFF) {
+ return () if (length($body) <= $i);
$ch = substr($body, $i, 1); $i++;
}
# markers can be padded with any number of 0xFF.
while (ord($ch) == 0xFF) {
+ return () if (length($body) <= $i);
$ch = substr($body, $i, 1); $i++;
}
($marker != 0xC4) &&
($marker != 0xCC)) { # it's a SOFn marker
$i += 3;
+ return () if (length($body) <= $i);
my $s = substr($body, $i, 4); $i += 4;
my ($a,$b,$c,$d) = unpack("C"x4, $s);
return (($c<<8|$d), ($a<<8|$b));
} else {
# We must skip variables, since FFs in variable names aren't
# valid JPEG markers.
+ return () if (length($body) <= $i);
my $s = substr($body, $i, 2); $i += 2;
my ($c1, $c2) = unpack ("C"x2, $s);
my $length = ($c1 << 8) | $c2;
my $img_width; # size of the image being generated.
my $img_height;
-my $delay = 0;
+my $delay = 2;
sub x_cleanup {
sub x_or_pbm_output {
+ # Check for our helper program, to see whether we need to use PPM pipelines.
+ #
+ $_ = "webcollage-helper";
+ if (defined ($webcollage_helper) || which ($_)) {
+ $webcollage_helper = $_ unless (defined($webcollage_helper));
+ LOG ($verbose_pbm, "found \"$webcollage_helper\"");
+ $webcollage_helper .= " -v";
+ } else {
+ LOG (($verbose_pbm || $verbose_load), "no $_ program");
+ }
+
# make sure the various programs we execute exist, right up front.
#
- foreach ("ppmmake", "giftopnm", "djpeg", "pnmpaste", "pnmscale", "pnmcut") {
+ my @progs = ("ppmmake"); # always need this one
+
+ if (!defined($webcollage_helper)) {
+ # Only need these others if we don't have the helper.
+ @progs = (@progs, "giftopnm", "djpeg", "pnmpaste", "pnmscale", "pnmcut");
+ }
+
+ foreach (@progs) {
which ($_) || error "$_ not found on \$PATH.";
}
LOG ($verbose_pbm, "got $img (" . length($body) . ")");
- my ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1);
- $body = undef;
- if (!$iw || !$ih) {
- LOG ($verbose_pbm, "unable to make PBM from $img");
- return 0;
+ my ($iw, $ih);
+
+ # If we are using the webcollage-helper, then we do not need to convert this
+ # image to a PPM. But, if we're using a filter command, we still must, since
+ # that's what the filters expect (webcollage-helper can read PPMs, so that's
+ # fine.)
+ #
+ if (defined ($webcollage_helper) &&
+ !defined ($filter_cmd)) {
+
+ ($iw, $ih) = image_size ($body);
+ if (!$iw || !$ih) {
+ LOG (($verbose_pbm || $verbose_load),
+ "not a GIF or JPG" .
+ (($body =~ m@<(base|html|head|body|script|table|a href)>@i)
+ ? " (looks like HTML)" : "") .
+ ": $img");
+ $suppress_audit = 1;
+ $body = undef;
+ return 0;
+ }
+
+ local *OUT;
+ open (OUT, ">$image_tmp1") || error ("writing $image_tmp1: $!");
+ print OUT $body || error ("writing $image_tmp1: $!");
+ close OUT || error ("writing $image_tmp1: $!");
+
+ } else {
+ ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1);
+ $body = undef;
+ if (!$iw || !$ih) {
+ LOG ($verbose_pbm, "unable to make PBM from $img");
+ return 0;
+ }
}
record_success ($load_method, $img, $base);
my $target_h = $img_height;
my $cmd = "";
+ my $scale = 1.0;
# Usually scale the image to fit on the screen -- but sometimes scale it
# scale it to fit, we instead cut it in half until it fits -- that should
# give a wider distribution of sizes.
#
- if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; }
- if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; }
+ if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; $scale /= 2; }
+ if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; $scale /= 2; }
if ($iw > $target_w || $ih > $target_h) {
while ($iw > $target_w ||
$cmd =~ s@^ *\| *@@;
- $_ = "($cmd)";
- $_ .= " < $image_tmp1 > $image_tmp2";
+ if (defined ($webcollage_helper)) {
+ $cmd = "$webcollage_helper $image_tmp1 $image_ppm " .
+ "$scale $opacity " .
+ "$crop_x $crop_y $x $y " .
+ "$iw $ih";
+ $_ = $cmd;
+
+ } else {
+ # use a PPM pipeline
+ $_ = "($cmd)";
+ $_ .= " < $image_tmp1 > $image_tmp2";
+ }
if ($verbose_pbm) {
$_ = "($_) 2>&1 | sed s'/^/" . blurb() . "/'";
} else {
$_ .= " 2> /dev/null";
}
+
my $rc = nontrapping_system ($_);
+ if (defined ($webcollage_helper) && -z $image_ppm) {
+ LOG (1, "failed command: \"$cmd\"");
+ print STDERR "\naudit log:\n\n\n";
+ print STDERR ("#" x 78) . "\n";
+ print STDERR blurb() . "$image_ppm has zero size\n";
+ showlog();
+ print STDERR "\n\n";
+ exit (1);
+ }
+
if ($rc != 0) {
LOG (($verbose_pbm || $verbose_load), "failed command: \"$cmd\"");
LOG (($verbose_pbm || $verbose_load), "failed URL: \"$img\" (${ow}x$oh)");
return;
}
- rename ($image_tmp2, $image_ppm) || return;
+ if (!defined ($webcollage_helper)) {
+ rename ($image_tmp2, $image_ppm) || return;
+ }
my $target = "$image_ppm";
# cumulative.
#
if ($post_filter_cmd) {
+
+ my $cmd;
+
$target = $image_tmp1;
- $rc = nontrapping_system "($post_filter_cmd) < $image_ppm > $target";
+ if (!defined ($webcollage_helper)) {
+ $cmd = "($post_filter_cmd) < $image_ppm > $target";
+ } else {
+ # Blah, my scripts need the JPEG data, but some other folks need
+ # the PPM data -- what to do? Ignore the problem, that's what!
+# $cmd = "djpeg < $image_ppm | ($post_filter_cmd) > $target";
+ $cmd = "($post_filter_cmd) < $image_ppm > $target";
+ }
+
+ $rc = nontrapping_system ($cmd);
if ($rc != 0) {
LOG ($verbose_pbm, "filter failed: \"$post_filter_cmd\"\n");
return;
$http_proxy = shift @ARGV;
} elsif ($_ eq "-dictionary" || $_ eq "-dict") {
$dict = shift @ARGV;
+ } elsif ($_ eq "-debug" || $_ eq "--debug") {
+ my $which = shift @ARGV;
+ my @rest = @search_methods;
+ my $ok = 0;
+ while (@rest) {
+ my $pct = shift @rest;
+ my $name = shift @rest;
+ my $tfn = shift @rest;
+
+ if ($name eq $which) {
+ @search_methods = (100, $name, $tfn);
+ $ok = 1;
+ last;
+ }
+ }
+ error "no such search method as \"$which\"" unless ($ok);
+ LOG (1, "DEBUG: using only \"$which\"");
+
} else {
print STDERR "$copyright\nusage: $progname [-root]" .
" [-display dpy] [-root] [-verbose] [-timeout secs]\n" .
projects / xscreensaver / blobdiff