Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
PerlMonks - Spot The Monk!

by OeufMayo (Curate)
on Jun 15, 2001 at 17:19 UTC ( [id://88780]=CUFP: print w/replies, xml ) Need Help??

This script does basically what jcwren's infamous monkmap is doing, but isn't it cool to have a script like that on your own computer?

The version of this script requires a monks.xml file, listing all the monks coordinates. Thanks to jcwren, a daily updated XML file is now available at his site! Writing the script that grabs from the site XML is left as an exercise to the reader (the most lazy of you could probably try to convince me to post it too). Update: All the necessary files are now available for download (.tgz 2M).

If you like this node, be sure to ++ Corion's node too!

New! Daily updated pictures of the North American, Europe and World are available here

Caution, big pictures!

There's still some features to add, namely

  • Find a way to elegantly manage the overlapping names done!
  • Generate an Imagemap done!
  • The ability to dynamically zoom in/out in an area
  • Plenty of other things I'll think of in a few minutes

the up-to-date code is now located at the node


Fixed the text color, it's now really white
Added preview pics
v.0.02 : Now using Getopt::Mixed to parse the arguments, so much cleaner!
Added a bad attempt to fix the overlapping name problem
v.0.03 : A better way to avoid overlaps, thanks to Corion!
v.0.04 : An even better way to avoid overlaps and some changes in the logic, thanks again to Corion!
Moved to code to and added a link to the original XML file at
my $OeufMayo = new PerlMonger::Paris({http => ''});</kbd>

Replies are listed 'Best First'.
Banish the overlap (was:Re: - Spot The Monk!)
by Corion (Patriarch) on Jun 17, 2001 at 19:18 UTC

    After burning my mouth by giving incomplete intersection hints in the chatterbox and on my home node, I reworked the great program by jcwren (idea) and OeufMayo (realization) to reduce the overlap.

    There are some small glitches which I haven't yet worked out (for example, Tortue vs. Elgon), but the overlap has been reduced greatly. What would be interesting now would be some nice optimization to locate each monk as close as possible to the map marker, but I guess that's quite out of scope for a weekend hack :)

    Test images


    • Sorted the code a bit better, now everything gets drawn when it got calculated
    • Reject monks earlier when they are off-map

    #!/usr/bin/perl -w # # drawmap - spot the monk! # Briac 'OeufMayo' Pilpré # 2001/06/15 # Great earth maps available from +ng/earth.html # A jcwren's monkmap compliant map can be found at # -i=northam10k.jpg -o=monkmap_northam.jpg -x=-1280 -y=-896 + -m ./monks.xml -d cross.png -w 10800 -h 5400 -i=europe10k.jpg -o=monkmap_europe.jpg -x=-4880 -y=-695 + -m ./monks.xml -d cross.png -w 10800 -h 5400 -i=small_earth.jpg -o=monkmap_world.jpg -x=-25 -y=-3 + -m ./monks.xml -d cross.png -C use strict; use lib 'lib/'; use vars qw($VERSION); $VERSION = 0.03; use XML::Simple; use Getopt::Mixed 'nextOption'; use GD; Getopt::Mixed::init('C:i i=s o=s d=s w=i h=i x:i y:i m=s xml>m dot>d w +idth>w height>h input>i output>o offsetx>x offsety>y nocaption>C'); die "Uhoh" unless rectangles_intersect(589,573,645,586, 598,572,640,58 +5); die "Uhoh" unless rectangles_intersect(598,572,640,585, 589,573,645,58 +6); # Fetch the command line parameters my ($input, $output, $offsetx, $offsety, $dot, $xml, $width, $height, +$nocaption); while (my ($option, $value, $pretty) = nextOption()) { $input = $value if $option eq 'i'; $output = $value if $option eq 'o'; $offsetx = $value if $option eq 'x'; $offsety = $value if $option eq 'y'; $xml = $value if $option eq 'm'; $dot = $value if $option eq 'd'; $width = $value if $option eq 'w'; $height = $value if $option eq 'h'; $nocaption = 1 if $option eq 'C'; } Getopt::Mixed::cleanup(); &usage unless ($input && $output); $offsetx ||= 0; $offsety ||= 0; my %monks; # Parse the monks coordinates XML file I fetched from jcwren's stats s +ite. # ( code to fetch & create the XML is available on request ) my $xs = new XML::Simple(); my $ref = $xs->XMLin($xml); # Fill the monks hash with their respective locations foreach (keys %{$ref->{monk}}){ push (@{$monks{$_}}, ( $ref->{monk}->{$_}->{location}->{latit +ude}, $ref->{monk}->{$_}->{location}->{longi +tude}, )); } # Load the pictures we need. my $map = GD::Image->newFromJpeg($input); my $flag = GD::Image->newFromPng($dot); my $white = $map->colorResolve(255,255,255); my $black = $map->colorResolve(0,0,0); unless ($width && $height){ ($width, $height) = $map->getBounds(); } my %points; #keep track of the points for managing monks densit +y my %boxes; #keep track of the caption bounding boxes # First, lets filter out all monks not on the map : my ($img_width,$img_height) = $map->getBounds(); my @monks_off_map = grep { my ($x,$y) = coord2pix($monks{$_}->[0],$monk +s{$_}->[1], $width, $height); # Tweak the x/y to fit the picture $x += $offsetx; $y += $offsety; # We want only the off-map monks : ! (between(0,$width-$offsetx, $x) && betw +een(0,$height-$offsety,$y)) || ! (between(0,$img_width, $x) && between(0 +,$img_height,$y)); } keys %monks; foreach (@monks_off_map) { #print "Goodbye, $_\n"; delete $monks{$_} }; # Now, we want to place all position markers : my $f = 6; # "closeness" factor foreach (keys %monks){ # Convert the lat/long to x/y my ($x,$y) = coord2pix($monks{$_}->[0],$monks{$_}->[1], $width, $heig +ht); # Tweak the x/y to fit the picture $x += $offsetx; $y += $offsety; $points{$_} = [$x-$f, $y-$f, $x+$f, $y+$f]; # store the cur +rent pos $boxes{"__$_"} = [$x-$f, $y-$f, $x+$f, $y+$f]; # store the cur +rent pos of the bbox # Pinpoints the monk location on the map $map->copy($flag, $x, $y, 0,0,7,7); }; foreach (keys %monks){ # Convert the lat/long to x/y my ($x,$y) = coord2pix($monks{$_}->[0],$monks{$_}->[1], $width, $heig +ht); # Tweak the x/y to fit the picture $x += $offsetx; $y += $offsety; # Let's find if we have a monk close to the current one unless ($nocaption){ my ($x1,$y1); my ($radius, $angle) = (10,0); my $textl = 7 * length($_); #length of the capt +ion # Create a box for the label my @box = (int($x-$textl/2), $y-17, int($x+$textl/2), +$y-18+13); if (find_density(\%points, $_, $x,$y) || # If tru +e the monk is too close find_intersect(\%boxes, $_, @box) # or the + place has been taken already ) { CLOSE :{ $radius += 5; $angle += 10 % 360; # Find a point on a circle. # provided by CheeseLord: (x+r cos a, y+r sin a) ($x1,$y1)=(int($x + ($radius * cos $angle)), int($ +y+($radius * sin $angle))); # Move the label @box = (int($x1-$textl/2), $y1, int($x1+$textl/2), + $y1+13); # Check to see if it intersects with a previous ca +ption redo CLOSE if find_intersect(\%boxes, $_, @box); $map->line($x+4, $y+4, $x1+4, $y1+4, $white); $map->string(gdMediumBoldFont, $x1 - $textl/2 + 2, + $y1, $_, $black); $map->string(gdMediumBoldFont, $x1 - $textl/2 + 3, + $y1, $_, $white); } } else { $map->string(gdMediumBoldFont, int($x - $textl/2)+ +1, $y-17, $_, $black); $map->string(gdMediumBoldFont, int($x - $textl/2), + $y-18, $_, $white); } $boxes{$_} = [@box]; } } # We now save our masterpiece on a storage device open JPGOUT, "> $output" or die $!; binmode JPGOUT; print JPGOUT $map->jpeg(75); sub between { my ($a1,$a2,$b) = @_; return ($a1 <= $b) && ($b <= $a2); }; sub point_in_rectangle { my ($left,$top,$right,$bottom,$x,$y) = @_; return between($left,$right,$x) && between($top,$bottom,$y) }; sub rectangles_intersect { my ($a_lft,$a_top,$a_rgt,$a_btm,$b_lft,$b_top,$b_rgt,$b_btm) = @_; return ( # One of the four corners within the other rec +tangle point_in_rectangle($a_lft,$a_top,$a_rgt,$a_btm +,$b_lft,$b_top) || point_in_rectangle($a_lft,$a_top,$a_rgt,$a_btm +,$b_rgt,$b_top) || point_in_rectangle($a_lft,$a_top,$a_rgt,$a_btm +,$b_lft,$b_btm) || point_in_rectangle($a_lft,$a_top,$a_rgt,$a_btm +,$b_rgt,$b_btm) || point_in_rectangle($b_lft,$b_top,$b_rgt,$b_btm +,$a_lft,$a_top) || point_in_rectangle($b_lft,$b_top,$b_rgt,$b_btm +,$a_rgt,$a_top) || point_in_rectangle($b_lft,$b_top,$b_rgt,$b_btm +,$a_lft,$a_btm) || point_in_rectangle($b_lft,$b_top,$b_rgt,$b_btm +,$a_rgt,$a_btm) || # Or an intersection where no corner is within + the other rectangle ( between( $a_lft, $a_rgt, $b_lft ) && between( $a_lft, $a_rgt, $b_rgt ) && between( $b_top, $b_btm, $a_top ) && between( $b_top, $b_btm, $a_btm ) ) || ( between( $b_lft, $b_rgt, $a_lft ) && between( $b_lft, $b_rgt, $a_rgt ) && between( $a_top, $a_btm, $b_top ) && between( $a_top, $a_btm, $b_btm ) ) ); }; sub find_intersect { my $boxes = shift; my $current = shift; my ($a_lft,$a_top, $a_rgt, $a_btm) = @_; my $overlap; foreach (keys %{$boxes}){ next if $_ eq $current; next if $_ eq "__$current"; # The own +location marker is never "too close" my ($b_lft,$b_top, $b_rgt, $b_btm) = @{$boxes->{$_}}; # Collison tests provided by Corion. I probably left s +ome out. if (rectangles_intersect($a_lft,$a_top,$a_rgt,$a_btm,$ +b_lft,$b_top,$b_rgt,$b_btm)){ $overlap++; last; } } return $overlap; } sub find_density { my $dens = shift; my $current = shift; my ($x,$y) = @_; my $too_close; foreach (keys %{$dens}){ next if $_ eq $current; my ($x1,$y1,$x2,$y2) = @{$dens->{$_}}; if (point_in_rectangle($x1,$y1,$x2,$y2, $x,$y)){ $too_close++; last; } } return $too_close; } sub coord2pix { # Convert the lat/long to their actual coordinates in the # picture (thanks to jcwren for the tips!) my ($lat, $long, $width, $height) = @_; my $x = $width / 2 + ($long / 360 * $width); my $y = $height / 2 - ($lat / 180 * $height); return ( int $x, int $y ); } sub usage { print STDERR <<"__USAGE__"; drawmap - v.$VERSION perl -i inputfile.jpg -o outputfile.jpg -m ./locat.xml -d +dot.png Required arguments: -i --input : Name of the map base. -o --output : Name of the output file created by drawmap -d --dot : Location of the png used as location marker -m --xml : Location of the xml coordinates file Optional arguments: -x --offsetx : Offset of the x axis -y --offsety : Offset of the y axis -C --nocaption : Does not draw the caption above the marker -w --width : Width of the original whole earth map (useful when zoo +ming) -h --height : Height of the original whole earth map __USAGE__ die "\n"; } __DATA__ <!-- monks.xml DTD --> <!ELEMENT monkmap (monk+)> <!ELEMENT monk (name, location)> <!ATTLIST monk id CDATA #REQUIRED> <!ELEMENT name (#PCDATA)> <!ELEMENT location (latitude, longitude)> <!ELEMENT latitude (#PCDATA)> <!ELEMENT longitude (#PCDATA)>
(jcwren) Re: - Spot The Monk!
by jcwren (Prior) on Jun 15, 2001 at 20:29 UTC


    If anyone is interested, I could export the Monk Map data as an XML file. This would prevent anyone from having to write a script to parse the pages (which means it won't break if the format changes), and generate unnecessary hits on the server. I can also make the map available.

    Jeffa did a great job reducing the map from about 40 colors to 5 or 6 (I think). I'd like to see it reduced further to a *true* three color map, with all the lines fixed up.


    e-mail jcwren
(jcwren) Re: - Spot The Monk! (XML Available)
by jcwren (Prior) on Jun 19, 2001 at 07:45 UTC

    I've added a cronjob entry that creates a monks.xml from the stats database every night around 03:30 EST/EDT.

    The URL is This file is generated immediately after the stats run, which can take as long as half an hour to complete.

    I modified one item in the format. The opening <monkmap> tag contains the GMT date the file was generated, and the originating URL. Example:

    <monkmap generated="Tue Jun 19 03:40:43 2001 GMT" source="">

    I think I got the format correct, but I'm not sure of all the characters that should be escaped or not. If you find a problem with it, please let me know. I do know that the XML view in IE didn't whine about it, for whatever that's worth.

    If you have a program that uses this data, please consider cacheing it locally, and updating it around 05:00 EST/EDT. This will help reduce traffic on the IDSL line.


    e-mail jcwren
Re: - Spot The Monk!
by grinder (Bishop) on Jun 16, 2001 at 13:02 UTC
    Find a way to elegantly manage the overlapping names

    You want to get in touch with Léon Brocard, and ask him how he solved this problem on the Perl Monger World Map. (Zoom in on a section to see what I mean). I'm sure he'll give you the source if you ask nicely.

    g r i n d e r
Re: - Spot The Monk!
by stefp (Vicar) on Jun 17, 2001 at 18:02 UTC
    I don't know if you have choice of map projections but a north centric one like Mercator would seem more appropriate due to the density of PMs in the northern hemisphere. Its "unfairness" (northern hemisphere appears to be way bigger than the southern one) is a good property here.

    See map projections and Mercator Projection at for more info.

    -- stefp

      I apologise for a mild attack on a liberal shibboleth, but the Mercator Projection is only 'north-centric' if one is particularly concerned about equal area properties, in which case one wouldn't choose it at all, but would use Lambert's or another such projection. The reason that the Mercator projection appears to enhance the North is not (as some would have you believe) that it was designed by some chauvinistic northerner (although it may have been) but because there is comparatively little habitable land in the southern hemisphere. If you get a proper Mercator map (that is, one which actually has the equator half-way up it, and not over 2/3 of the way down it), you'll see that the Southern Hemisphere is depicted as largely water (which is accurate, although the precise details are distorted by the projection), and Antarctica appears huge - about as big as Asia.

      This has been your daily Irrelevant Iconoclasm.

      Tiefling (who thinks there are better ways of highlighting the plight of the 'South' than lying about cartography)

      -----BEGIN GEEK CODE BLOCK----- Version: 3.1 GAT d++ s:- a-- C++ UL P++ L++(+) E? W+(++) N+ o? K w+(--) !O M- V? PS+ PE- Y PGP- t+ 5 X+ R+++ tv- b+++ DI++++ D+ G+ e++ h!(-) y +? ------END GEEK CODE BLOCK------
Re: - Spot The Monk!
by Jouke (Curate) on Jun 15, 2001 at 18:09 UTC
    # We now save our masterpiece on a storage device open PNGOUT, '> monkmap.jpg' or die $!; binmode PNGOUT; print PNGOUT $map->jpeg(75);
    I guess you originally used PNG as output format ;-) ?

    Jouke Visser, Perl 'Adept'
    Using Perl to help the disabled: pVoice and pStory

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://88780]
Approved by root
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (2)
As of 2024-04-17 10:29 GMT
Find Nodes?
    Voting Booth?

    No recent polls found