ftp://ftp.linux.ncsu.edu/mirror/ftp.redhat.com/pub/redhat/linux/enterprise/4/en/os...
[xscreensaver] / hacks / webcollage
index 42f20ab4b65345d443974399e76c21f91e838a45..d7764e08e7ea645bc983ef9016bf7176b0b533b9 100755 (executable)
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# webcollage, Copyright (c) 1999-2003 by Jamie Zawinski <jwz@jwz.org>
+# webcollage, Copyright (c) 1999-2004 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."
 #
 #
 #     webcollage -root
 #     webcollage -root -filter 'vidwhacker -stdin -stdout'
-
-
+#
+#
+# You can see this in action at http://www.jwz.org/webcollage/ --
+# it auto-reloads about once a minute.  To make a page similar to
+# that on your own system, do this:
+#
+#     webcollage -size '800x600' -imagemap $HOME/www/webcollage/index
+#
+#
 # If you have the "driftnet" program installed, webcollage can display a
 # collage of images sniffed off your local ethernet, instead of pulled out
 # of search engines: in that way, your screensaver can display the images
@@ -53,16 +60,18 @@ use bytes;  # Larry can take Unicode and shove it up his ass sideways.
 
 
 my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.107 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
-my $copyright = "WebCollage $version, Copyright (c) 1999-2002" .
+my $version = q{ $Revision: 1.117 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $copyright = "WebCollage $version, Copyright (c) 1999-2004" .
     " Jamie Zawinski <jwz\@jwz.org>\n" .
-    "            http://www.jwz.org/xscreensaver/\n";
+    "            http://www.jwz.org/webcollage/\n";
 
 
 
-my @search_methods = (  77, "altavista",  \&pick_from_alta_vista_random_link,
-                        14, "yahoorand",  \&pick_from_yahoo_random_link,
-                         9, "yahoonews",  \&pick_from_yahoo_news_text,
+my @search_methods = (  71, "altavista",   \&pick_from_alta_vista_random_link,
+                        10, "livejournal", \&pick_from_livejournal_images,
+                         8, "yahoorand",   \&pick_from_yahoo_random_link,
+                         6, "yahoonews",   \&pick_from_yahoo_news_text,
+                         5, "ircimages",   \&pick_from_ircimages,
 
                      # Alta Vista has a new "random link" URL now.
                      # They added it specifically to better support webcollage!
@@ -114,6 +123,8 @@ my %cookies = (
   "www.nytimes.com"    =>  'NYT-S=18cHMIlJOn2Y1bu5xvEG3Ufuk6E1oJ.' .
                            'FMxWaQV0igaB5Yi/Q/guDnLeoL.pe7i1oakSb' .
                            '/VqfdUdb2Uo27Vzt1jmPn3cpYRlTw9',
+
+  "ircimages.com"      =>  'disclaimer=1',
 );
 
 
@@ -214,6 +225,7 @@ my $min_gif_area = (120 * 120);
 
 my $no_output_p = 0;
 my $urls_only_p = 0;
+my $imagemap_base = undef;
 
 my @pids_to_kill = ();  # forked pids we should kill when we exit, if any.
 
@@ -261,6 +273,11 @@ sub get_document_1 {
   my ($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
   $path = "" unless $path;
 
+  if (!$url_proto || !$serverstring) {
+    LOG (($verbose_net || $verbose_load), "unparsable URL: $url");
+    return ();
+  }
+
   my ($them,$port) = split(/:/, $serverstring);
   $port = 80 unless $port;
 
@@ -316,7 +333,8 @@ sub get_document_1 {
       my $user_agent = "$progname/$version";
 
       if ($url =~ m@^http://www\.altavista\.com/@ ||
-          $url =~ m@^http://random\.yahoo\.com/@) {
+          $url =~ m@^http://random\.yahoo\.com/@ ||
+          $url =~ m@^http://images\.google\.com/@) {
         # block this, you turkeys.
         $user_agent = "Mozilla/4.76 [en] (X11; U; Linux 2.2.16-22 i686; Nav)";
       }
@@ -548,9 +566,9 @@ sub pick_image_from_body {
   # randomly from the set of images on the web.  All the logic here for
   # rejecting some images is really a set of heuristics for rejecting
   # images that are not really images: for rejecting *text* that is in
-  # GIF/JPEG form.  I don't want text, I want pictures, and I want the
-  # content of the pictures to be randomly selected from among all the
-  # available content.
+  # GIF/JPEG/PNG form.  I don't want text, I want pictures, and I want
+  # the content of the pictures to be randomly selected from among all
+  # the available content.
   #
   # So, filtering out "dirty" pictures by looking for "dirty" keywords
   # would be wrong: dirty pictures exist, like it or not, so webcollage
@@ -630,7 +648,7 @@ sub pick_image_from_body {
       }
 
       # skip non-image
-      if ( ! m@[.](gif|jpg|jpeg|pjpg|pjpeg)$@io ) {
+      if ( ! m@[.](gif|jpg|jpeg|pjpg|pjpeg|png)$@io ) {
         next;
       }
 
@@ -679,9 +697,9 @@ sub pick_image_from_body {
       $urls[++$#urls] = $url;
       $unique_urls{$url}++;
 
-      # jpegs are preferable to gifs.
+      # JPEGs are preferable to GIFs and PNGs.
       $_ = $url;
-      if ( ! m@[.]gif$@io ) {
+      if ( ! m@[.](gif|png)$@io ) {
         $urls[++$#urls] = $url;
       }
 
@@ -797,6 +815,24 @@ sub url_unquote {
   return $s;
 }
 
+sub html_quote {
+  my ($s) = @_;
+  $s =~ s/&/&amp;/gi;
+  $s =~ s/</&lt;/gi;
+  $s =~ s/>/&gt;/gi;
+  $s =~ s/\"/&quot;/gi;
+  return $s;
+}
+
+sub html_unquote {
+  my ($s) = @_;
+  $s =~ s/&lt;/</gi;       # far from exhaustive...
+  $s =~ s/&gt;/</gi;
+  $s =~ s/&quot;/\"/gi;
+  $s =~ s/&amp;/&/gi;
+  return $s;
+}
+
 
 # Loads the given URL (a search on some search engine) and returns:
 # - the total number of hits the search engine claimed it had;
@@ -1090,7 +1126,7 @@ my $alta_vista_images_url = "http://www.altavista.com/image/results" .
 sub pick_from_alta_vista_images {
   my ( $timeout ) = @_;
 
-  my $words = random_words(0);
+  my $words = random_word();
   my $page = (int(rand(9)) + 1);
   my $search_url = $alta_vista_images_url . $words;
 
@@ -1105,12 +1141,13 @@ sub pick_from_alta_vista_images {
   my @candidates = ();
   foreach my $u (@subpages) {
 
-    # avtext is encoding their URLs now.
-    next unless ($u =~ m@^/r.*\&r=([^&]+).*@);
-    $u = url_unquote($1);
+    # avimages is encoding their URLs now.
+    next unless ($u =~ s/^.*\*\*(http%3a.*$)/$1/gsi);
+    $u = url_unquote($u);
 
     next unless ($u =~ m@^http://@i);    #  skip non-HTTP or relative URLs
     next if ($u =~ m@[/.]altavista\.com\b@i);     # skip altavista builtins
+    next if ($u =~ m@[/.]yahoo\.com\b@i);         # yahoo and av in cahoots?
     next if ($u =~ m@[/.]doubleclick\.net\b@i);   # you cretins
     next if ($u =~ m@[/.]clicktomarket\.com\b@i); # more cretins
 
@@ -1180,7 +1217,7 @@ sub pick_from_google_images {
 ############################################################################
 #
 # Pick images by feeding random *numbers* into Google Image Search.
-# By jwz, suggested by from Ian O'Donnell.
+# By jwz, suggested by Ian O'Donnell.
 #
 ############################################################################
 
@@ -1216,7 +1253,8 @@ sub pick_from_google_image_numbers {
 
     if ($u =~ m@^/imgres\?imgurl=(.*?)\&imgrefurl=(.*?)\&@) {
       my $ref = $2;
-      my $img = "http://$1";
+      my $img = $1;
+      $img = "http://$img" unless ($img =~ m/^http:/i);
 
       LOG ($verbose_filter, "  candidate: $ref");
       push @candidates, $img;
@@ -1275,8 +1313,12 @@ sub pick_from_alta_vista_text {
     # onMouseOver to make it look like they're not!  Well, it makes it
     # easier for us to identify search results...
     #
-    next unless ($u =~ m@^/r.*\&r=([^&]+).*@);
-    $u = url_unquote($1);
+    next unless ($u =~ s/^.*\*\*(http%3a.*$)/$1/gsi);
+    $u = url_unquote($u);
+
+    next unless ($u =~ m@^http://@i);    #  skip non-HTTP or relative URLs
+    next if ($u =~ m@[/.]altavista\.com\b@i);     # skip altavista builtins
+    next if ($u =~ m@[/.]yahoo\.com\b@i);         # yahoo and av in cahoots?
 
     LOG ($verbose_filter, "  candidate: $u");
     push @candidates, $u;
@@ -1309,6 +1351,8 @@ my $hotbot_search_url =("http://hotbot.lycos.com/default.asp" .
 sub pick_from_hotbot_text {
   my ( $timeout ) = @_;
 
+  $last_search = $hotbot_search_url;   # for warnings
+
   # lycos seems to always give us back dictionaries and word lists if
   # we search for more than one word...
   #
@@ -1324,8 +1368,14 @@ sub pick_from_hotbot_text {
   foreach my $u (@subpages) {
 
     # Hotbot plays redirection games too
-    next unless ($u =~ m@/director.asp\?.*\btarget=([^&]+)@);
-    $u = url_decode($1);
+    # (not any more?)
+#    next unless ($u =~ m@/director.asp\?.*\btarget=([^&]+)@);
+#    $u = url_decode($1);
+
+    next unless ($u =~ m@^http://@i);    #  skip non-HTTP or relative URLs
+    next if ($u =~ m@[/.]hotbot\.com\b@i);     # skip hotbot builtins
+    next if ($u =~ m@[/.]lycos\.com\b@i);      # skip hotbot builtins
+    next if ($u =~ m@[/.]inktomi\.com\b@i);    # skip hotbot builtins
 
     LOG ($verbose_filter, "  candidate: $u");
     push @candidates, $u;
@@ -1352,6 +1402,8 @@ my $lycos_search_url = "http://search.lycos.com/default.asp" .
 sub pick_from_lycos_text {
   my ( $timeout ) = @_;
 
+  $last_search = $lycos_search_url;   # for warnings
+
   # lycos seems to always give us back dictionaries and word lists if
   # we search for more than one word...
   #
@@ -1367,12 +1419,20 @@ sub pick_from_lycos_text {
   foreach my $u (@subpages) {
 
     # Lycos plays redirection games.
-    next unless ($u =~ m@^http://click.lycos.com/director.asp
-                         .*
-                         \btarget=([^&]+)
-                         .*
-                        @x);
-    $u = url_decode($1);
+    # (not any more?)
+#    next unless ($u =~ m@^http://click.lycos.com/director.asp
+#                         .*
+#                         \btarget=([^&]+)
+#                         .*
+#                        @x);
+#    $u = url_decode($1);
+
+    next unless ($u =~ m@^http://@i);    #  skip non-HTTP or relative URLs
+    next if ($u =~ m@[/.]hotbot\.com\b@i);     # skip lycos builtins
+    next if ($u =~ m@[/.]lycos\.com\b@i);      # skip lycos builtins
+    next if ($u =~ m@[/.]terralycos\.com\b@i); # skip lycos builtins
+    next if ($u =~ m@[/.]inktomi\.com\b@i);    # skip lycos builtins
+
 
     LOG ($verbose_filter, "  candidate: $u");
     push @candidates, $u;
@@ -1404,6 +1464,8 @@ my $yahoo_news_url = "http://search.news.yahoo.com/search/news" .
 sub pick_from_yahoo_news_text {
   my ( $timeout ) = @_;
 
+  $last_search = $yahoo_news_url;   # for warnings
+
   my $words = random_words(0);
   my $search_url = $yahoo_news_url . $words;
 
@@ -1425,6 +1487,107 @@ sub pick_from_yahoo_news_text {
 }
 
 
+\f
+############################################################################
+#
+# Pick images from LiveJournal's list of recently-posted images.
+#
+############################################################################
+
+my $livejournal_img_url = "http://www.livejournal.com/stats/latest-img.bml";
+
+# livejournal
+sub pick_from_livejournal_images {
+  my ( $timeout ) = @_;
+
+  $last_search = $livejournal_img_url;   # for warnings
+
+  my ( $base, $body ) = get_document ($livejournal_img_url, undef, $timeout);
+  return () unless $body;
+
+  my @candidates = ();
+
+  $body =~ s/\n/ /gs;
+  $body =~ s/(<recent-image)\b/\n$1/gsi;
+
+  foreach (split (/\n/, $body)) {
+    next unless (m/^<recent-image\b/);
+    next unless (m/\bIMG=[\'\"]([^\'\"]+)[\'\"]/si);
+    my $img = html_unquote ($1);
+    next unless (m/\bURL=[\'\"]([^\'\"]+)[\'\"]/si);
+    my $page = html_unquote ($1);
+    my @pair = ($img, $page);
+    LOG ($verbose_filter, "  candidate: $img");
+    push @candidates, \@pair;
+  }
+
+  return () if ($#candidates == -1);
+
+  my $i = int(rand($#candidates+1));
+  my ($img, $page) = @{$candidates[$i]};
+
+  LOG ($verbose_load, "picked image " .($i+1) . "/" . ($#candidates+1) .
+       ": $img");
+
+  return ($page, $img);
+}
+
+\f
+############################################################################
+#
+# Pick images from ircimages.com (images that have been in the /topic of
+# various IRC channels.)
+#
+############################################################################
+
+my $ircimages_url = "http://ircimages.com/";
+
+# ircimages
+sub pick_from_ircimages {
+  my ( $timeout ) = @_;
+
+  $last_search = $ircimages_url;   # for warnings
+
+  my $n = int(rand(2900));
+  my $search_url = $ircimages_url . "page-$n";
+
+  my ( $base, $body ) = get_document ($search_url, undef, $timeout);
+  return () unless $body;
+
+  my @candidates = ();
+
+  $body =~ s/\n/ /gs;
+  $body =~ s/(<A)\b/\n$1/gsi;
+
+  foreach (split (/\n/, $body)) {
+
+    my ($u) = m@<A\s.*\bHREF\s*=\s*([^>]+)>@i;
+    next unless $u;
+
+    if ($u =~ m/^\"([^\"]*)\"/) { $u = $1; }   # quoted string
+    elsif ($u =~ m/^([^\s]*)\s/) { $u = $1; }  # or token
+
+    next unless ($u =~ m/^http:/i);
+    next if ($u =~ m@^http://(searchirc\.com\|ircimages\.com)@i);
+    next unless ($u =~ m@[.](gif|jpg|jpeg|pjpg|pjpeg|png)$@i);
+
+    LOG ($verbose_http, "    HREF: $u");
+    push @candidates, $u;
+  }
+
+  LOG ($verbose_filter, "" . $#candidates+1 . " links on $search_url");
+
+  return () if ($#candidates == -1);
+
+  my $i = int(rand($#candidates+1));
+  my $img = $candidates[$i];
+
+  LOG ($verbose_load, "picked image " .($i+1) . "/" . ($#candidates+1) .
+       ": $img");
+
+  $search_url = $img;  # hmm...
+  return ($search_url, $img);
+}
 
 \f
 ############################################################################
@@ -1893,14 +2056,29 @@ sub jpeg_size {
   return ();
 }
 
-# Given the raw body of a GIF or JPEG document, returns the dimensions of
-# the image.
+# Given the raw body of a PNG document, returns the dimensions of the image.
+#
+sub png_size {
+  my ($body) = @_;
+  return () unless ($body =~ m/^\211PNG\r/);
+  my ($bits) = ($body =~ m/^.{12}(.{12})/s);
+  return () unless defined ($bits);
+  return () unless ($bits =~ /^IHDR/);
+  my ($ign, $w, $h) = unpack("a4N2", $bits);
+  return ($w, $h);
+}
+
+
+# Given the raw body of a GIF, JPEG, or PNG document, returns the dimensions
+# of the image.
 #
 sub image_size {
   my ($body) = @_;
   my ($w, $h) = gif_size ($body);
   if ($w && $h) { return ($w, $h); }
-  return jpeg_size ($body);
+  ($w, $h) = jpeg_size ($body);
+  if ($w && $h) { return ($w, $h); }
+  return png_size ($body);
 }
 
 
@@ -1926,6 +2104,14 @@ sub bellrand {
 }
 
 
+sub exit_cleanup {
+  x_cleanup();
+  if (@pids_to_kill) {
+    print STDERR blurb() . "killing: " . join(' ', @pids_to_kill) . "\n";
+    kill ('TERM', @pids_to_kill);
+  }
+}
+
 sub signal_cleanup {
   my ($sig) = @_;
   print STDERR blurb() . (defined($sig)
@@ -1933,17 +2119,11 @@ sub signal_cleanup {
                           : "exiting.")
                        . "\n"
     if ($verbose_exec);
-
-  x_cleanup();
-
-  if (@pids_to_kill) {
-    print STDERR blurb() . "killing: " . join(' ', @pids_to_kill) . "\n";
-    kill ('TERM', @pids_to_kill);
-  }
-
   exit 1;
 }
 
+
+
 ##############################################################################
 #
 # Generating a list of urls only
@@ -1967,14 +2147,25 @@ sub url_only_output {
 #
 ##############################################################################
 
-my $image_ppm   = ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp") . "/webcollage." . $$;
-my $image_tmp1  = $image_ppm . "-1";
-my $image_tmp2  = $image_ppm . "-2";
+my $image_ppm   = sprintf ("%s/webcollage-%08x",
+                           ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"),
+                           rand(0xFFFFFFFF));
+my $image_tmp1  = sprintf ("%s/webcollage-1-%08x",
+                           ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"),
+                           rand(0xFFFFFFFF));
+my $image_tmp2  = sprintf ("%s/webcollage-2-%08x",
+                           ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"),
+                           rand(0xFFFFFFFF));
 
 my $filter_cmd = undef;
 my $post_filter_cmd = undef;
 my $background = undef;
 
+my @imagemap_areas = ();
+my $imagemap_html_tmp = undef;
+my $imagemap_jpg_tmp = undef;
+
+
 my $img_width;            # size of the image being generated.
 my $img_height;
 
@@ -1982,6 +2173,8 @@ my $delay = 2;
 
 sub x_cleanup {
   unlink $image_ppm, $image_tmp1, $image_tmp2;
+  unlink $imagemap_html_tmp, $imagemap_jpg_tmp
+    if (defined ($imagemap_html_tmp));
 }
 
 
@@ -2017,9 +2210,9 @@ sub nontrapping_system {
 }
 
 
-# Given the URL of a GIF or JPEG image, and the body of that image, writes a
-# PPM to the given output file.  Returns the width/height of the image if
-# successful.
+# Given the URL of a GIF, JPEG, or PNG image, and the body of that image,
+# writes a PPM to the given output file.  Returns the width/height of the
+# image if successful.
 #
 sub image_to_pnm {
   my ($url, $body, $output) = @_;
@@ -2031,9 +2224,12 @@ sub image_to_pnm {
   } elsif ((@_ = jpeg_size ($body))) {
     ($w, $h) = @_;
     $cmd = "djpeg";
+  } elsif ((@_ = png_size ($body))) {
+    ($w, $h) = @_;
+    $cmd = "pngtopnm";
   } else {
     LOG (($verbose_pbm || $verbose_load),
-         "not a GIF or JPG" .
+         "not a GIF, JPG, or PNG" .
          (($body =~ m@<(base|html|head|body|script|table|a href)>@i)
           ? " (looks like HTML)" : "") .
          ": $url");
@@ -2131,6 +2327,7 @@ my $ppm_to_root_window_cmd = undef;
 
 
 sub x_or_pbm_output {
+  my ($window_id) = @_;
 
   # Check for our helper program, to see whether we need to use PPM pipelines.
   #
@@ -2149,7 +2346,9 @@ sub x_or_pbm_output {
 
   if (!defined($webcollage_helper)) {
     # Only need these others if we don't have the helper.
-    @progs = (@progs, "giftopnm", "djpeg", "pnmpaste", "pnmscale", "pnmcut");
+    @progs = (@progs,
+              "giftopnm", "pngtopnm", "djpeg",
+              "pnmpaste", "pnmscale", "pnmcut");
   }
 
   foreach (@progs) {
@@ -2160,13 +2359,41 @@ sub x_or_pbm_output {
   #
   $ppm_to_root_window_cmd = pick_root_displayer();
 
+  if (defined ($window_id)) {
+    error ("-window-id only works if xscreensaver-getimage is installed")
+      unless ($ppm_to_root_window_cmd =~ m/^xscreensaver-getimage\b/);
+
+    error ("unparsable window id: $window_id")
+      unless ($window_id =~ m/^\d+$|^0x[\da-f]+$/i);
+    $ppm_to_root_window_cmd =~ s/--?root\b/$window_id/ ||
+      error ("unable to munge displayer: $ppm_to_root_window_cmd");
+  }
+
   if (!$img_width || !$img_height) {
-    $_ = "xdpyinfo";
-    which ($_) || error "$_ not found on \$PATH.";
-    $_ = `$_`;
-    ($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /;
-    if (!defined($img_height)) {
-      error "xdpyinfo failed.";
+
+    if (!defined ($window_id) &&
+        defined ($ENV{XSCREENSAVER_WINDOW})) {
+      $window_id = $ENV{XSCREENSAVER_WINDOW};
+    }
+
+    if (!defined ($window_id)) {
+      $_ = "xdpyinfo";
+      which ($_) || error "$_ not found on \$PATH.";
+      $_ = `$_`;
+      ($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /;
+      if (!defined($img_height)) {
+        error "xdpyinfo failed.";
+      }
+    } else {  # we have a window id
+      $_ = "xwininfo";
+      which ($_) || error "$_ not found on \$PATH.";
+      $_ .= " -id $window_id";
+      $_ = `$_`;
+      ($img_width, $img_height) = m/^\s*Width:\s*(\d+)\n\s*Height:\s*(\d+)\n/m;
+
+      if (!defined($img_height)) {
+        error "xwininfo failed.";
+      }
     }
   }
 
@@ -2215,13 +2442,17 @@ sub x_or_pbm_output {
       ($iw, $ih) = @_;
       $cmd = "djpeg |";
 
+    } elsif ((@_ = png_size ($body))) {
+      ($iw, $ih) = @_;
+      $cmd = "pngtopnm |";
+
     } elsif ($body =~ m/^P\d\n(\d+) (\d+)\n/) {
       $iw = $1;
       $ih = $2;
       $cmd = "";
 
     } else {
-      error "$bgimage is not a GIF, JPEG, or PPM.";
+      error "$bgimage is not a GIF, JPEG, PNG, or PPM.";
     }
 
     my $x = int (($img_width  - $iw) / 2);
@@ -2282,7 +2513,7 @@ sub paste_image {
     ($iw, $ih) = image_size ($body);
     if (!$iw || !$ih) {
       LOG (($verbose_pbm || $verbose_load),
-           "not a GIF or JPG" .
+           "not a GIF, JPG, or PNG" .
            (($body =~ m@<(base|html|head|body|script|table|a href)>@i)
             ? " (looks like HTML)" : "") .
            ": $img");
@@ -2335,7 +2566,7 @@ sub paste_image {
     return 0 unless ($iw && $ih);
   }
 
-  my $target_w = $img_width;
+  my $target_w = $img_width;   # max rectangle into which the image must fit
   my $target_h = $img_height;
 
   my $cmd = "";
@@ -2343,25 +2574,27 @@ sub paste_image {
 
 
   # Usually scale the image to fit on the screen -- but sometimes scale it
-  # to fit on half or a quarter of the screen.  Note that we don't merely
-  # scale it to fit, we instead cut it in half until it fits -- that should
-  # give a wider distribution of sizes.
+  # to fit on half or a quarter of the screen.  (We do this by reducing the
+  # size of the target rectangle.)  Note that the image is not merely scaled
+  # to fit; we instead cut the image in half repeatedly until it fits in the
+  # target rectangle -- that gives a wider distribution of sizes.
   #
-  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 (rand() < 0.3) { $target_w /= 2; $target_h /= 2; } # reduce target rect
+  if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; }
 
   if ($iw > $target_w || $ih > $target_h) {
     while ($iw > $target_w ||
            $ih > $target_h) {
       $iw = int($iw / 2);
       $ih = int($ih / 2);
+      $scale /= 2;
     }
     if ($iw <= 10 || $ih <= 10) {
       LOG ($verbose_pbm, "scaling to ${iw}x$ih would have been bogus.");
       return 0;
     }
 
-    LOG ($verbose_pbm, "scaling to ${iw}x$ih");
+    LOG ($verbose_pbm, "scaling to ${iw}x$ih ($scale)");
 
     $cmd .= " | pnmscale -xsize $iw -ysize $ih";
   }
@@ -2448,7 +2681,7 @@ sub paste_image {
   # If any cropping needs to happen, add pnmcut.
   #
   if ($crop_x != 0   || $crop_y != 0 ||
-        $crop_w != $iw || $crop_h != $ih) {
+      $crop_w != $iw || $crop_h != $ih) {
     $iw = $crop_w;
     $ih = $crop_h;
     $cmd .= " | pnmcut $crop_x $crop_y $iw $ih";
@@ -2562,12 +2795,122 @@ sub paste_image {
   print STDOUT "image: ${iw}x${ih} @ $x,$y $base $source\n"
     if ($verbose_imgmap);
 
+  if ($imagemap_base) {
+    update_imagemap ($base, $x, $y, $iw, $ih,
+                     $image_ppm, $img_width, $img_height);
+  }
+
   clearlog();
 
   return 1;
 }
 
 
+sub update_imagemap {
+  my ($url, $x, $y, $w, $h, $image_ppm, $image_width, $image_height) = @_;
+
+  $current_state = "imagemap";
+
+  my $max_areas = 200;
+
+  $url = html_quote ($url);
+  my $x2 = $x + $w;
+  my $y2 = $y + $h;
+  my $area = "<AREA SHAPE=RECT COORDS=\"$x,$y,$x2,$y2\" HREF=\"$url\">";
+  unshift @imagemap_areas, $area;      # put one on the front
+  if ($#imagemap_areas >= $max_areas) {
+    pop @imagemap_areas;               # take one off the back.
+  }
+
+  LOG ($verbose_pbm, "area: $x,$y,$x2,$y2 (${w}x$h)");
+
+  my $map_name = $imagemap_base;
+  $map_name =~ s@^.*/@@;
+  $map_name = 'collage' if ($map_name eq '');
+
+  my $imagemap_html = $imagemap_base . ".html";
+  my $imagemap_jpg  = $imagemap_base . ".jpg";
+
+  if (!defined ($imagemap_html_tmp)) {
+    $imagemap_html_tmp = $imagemap_html . sprintf (".%08x", rand(0xffffffff));
+    $imagemap_jpg_tmp  = $imagemap_jpg  . sprintf (".%08x", rand(0xffffffff));
+  }
+
+  # Read the imagemap html file (if any) to get a template.
+  #
+  my $template_html = '';
+  {
+    local *IN;
+    if (open (IN, "<$imagemap_html")) {
+      while (<IN>) { $template_html .= $_; }
+      close IN;
+      LOG ($verbose_pbm, "read template $imagemap_html");
+    }
+
+    if ($template_html =~ m/^\s*$/s) {
+      $template_html = ("<MAP NAME=\"$map_name\"></MAP>\n" .
+                        "<IMG SRC=\"$imagemap_base.jpg\"" .
+                        " USEMAP=\"$map_name\">\n");
+      LOG ($verbose_pbm, "created dummy template");
+    }
+  }
+
+  # Write the jpg to a tmp file
+  #
+  {
+    my $cmd;
+    if (defined ($webcollage_helper)) {
+      $cmd = "cp -p $image_ppm $imagemap_jpg_tmp";
+    } else {
+      $cmd = "cjpeg < $image_ppm > $imagemap_jpg_tmp";
+    }
+    my $rc = nontrapping_system ($cmd);
+    if ($rc != 0) {
+      error ("imagemap jpeg failed: \"$cmd\"\n");
+    }
+  }
+
+  # Write the html to a tmp file
+  #
+  {
+    my $body = $template_html;
+    my $areas = join ("\n\t", @imagemap_areas);
+    my $map = ("<MAP NAME=\"$map_name\">\n\t$areas\n</MAP>");
+    my $img = ("<IMG SRC=\"$imagemap_base.jpg\" " .
+               "BORDER=0 " .
+               "WIDTH=$image_width HEIGHT=$image_height " .
+               "USEMAP=\"#$map_name\">");
+    $body =~ s@(<MAP\s+NAME=\"[^\"]*\"\s*>).*?(</MAP>)@$map@is;
+    $body =~ s@<IMG\b[^<>]*\bUSEMAP\b[^<>]*>@$img@is;
+
+    # if there are magic webcollage spans in the html, update those too.
+    #
+    {
+      my @st = stat ($imagemap_jpg_tmp);
+      my $date = strftime("%d-%b-%Y %l:%M:%S %p %Z", localtime($st[9]));
+      my $size = int(($st[7] / 1024) + 0.5) . "K";
+      $body =~ s@(<SPAN\s+CLASS=\"webcollage_date\">).*?(</SPAN>)@$1$date$2@si;
+      $body =~ s@(<SPAN\s+CLASS=\"webcollage_size\">).*?(</SPAN>)@$1$size$2@si;
+    }
+
+    local *OUT;
+    open (OUT, ">$imagemap_html_tmp") || error ("$imagemap_html_tmp: $!");
+    print OUT $body                   || error ("$imagemap_html_tmp: $!");
+    close OUT                         || error ("$imagemap_html_tmp: $!");
+    LOG ($verbose_pbm, "wrote $imagemap_html_tmp");
+  }
+
+  # Rename the two tmp files to the real files
+  #
+  rename ($imagemap_html_tmp, $imagemap_html) ||
+    error "renaming $imagemap_html_tmp to $imagemap_html";
+  LOG ($verbose_pbm, "wrote $imagemap_html");
+  rename ($imagemap_jpg_tmp,  $imagemap_jpg) ||
+    error "renaming $imagemap_jpg_tmp to $imagemap_jpg";
+  LOG ($verbose_pbm, "wrote $imagemap_jpg");
+}
+
+
 sub init_signals {
 
   $SIG{HUP}  = \&signal_cleanup;
@@ -2581,7 +2924,7 @@ sub init_signals {
   $SIG{PIPE} = 'IGNORE';
 }
 
-END { signal_cleanup(); }
+END { exit_cleanup(); }
 
 
 sub main {
@@ -2596,6 +2939,7 @@ sub main {
   $load_method = "none";
 
   my $root_p = 0;
+  my $window_id = undef;
 
   # historical suckage: the environment variable name is lower case.
   $http_proxy = $ENV{http_proxy} || $ENV{HTTP_PROXY};
@@ -2611,11 +2955,17 @@ sub main {
       $ENV{DISPLAY} = shift @ARGV;
     } elsif ($_ eq "-root") {
       $root_p = 1;
+    } elsif ($_ eq "-window-id" || $_ eq "--window-id") {
+      $window_id = shift @ARGV;
+      $root_p = 1;
     } elsif ($_ eq "-no-output") {
       $no_output_p = 1;
     } elsif ($_ eq "-urls-only") {
       $urls_only_p = 1;
       $no_output_p = 1;
+    } elsif ($_ eq "-imagemap") {
+      $imagemap_base = shift @ARGV;
+      $no_output_p = 1;
     } elsif ($_ eq "-verbose") {
       $verbose++;
     } elsif (m/^-v+$/) {
@@ -2670,8 +3020,9 @@ sub main {
     } else {
       print STDERR "$copyright\nusage: $progname " .
               "[-root] [-display dpy] [-verbose] [-debug which]\n" .
-        "\t\t  [-timeout secs] [-delay secs] [-filter cmd] [-filter2 cmd]\n" .
-        "\t\t  [-no-output] [-urls-only] [-background color] [-size WxH]\n" .
+        "\t\t  [-timeout secs] [-delay secs] [-size WxH]\n" .
+        "\t\t  [-no-output] [-urls-only] [-imagemap filename]\n" .
+        "\t\t  [-filter cmd] [-filter2 cmd] [-background color]\n" .
         "\t\t  [-dictionary dictionary-file] [-http-proxy host[:port]]\n" .
         "\t\t  [-driftnet [driftnet-program-and-args]]\n" .
         "\n";
@@ -2759,9 +3110,9 @@ sub main {
   spawn_driftnet ($driftnet_cmd) if ($driftnet_cmd);
 
   if ($urls_only_p) {
-    url_only_output;
+    url_only_output ();
   } else {
-    x_or_pbm_output;
+    x_or_pbm_output ($window_id);
   }
 }