#!/usr/bin/perl -w # # drawmap - spot the monk! # Briac 'OeufMayo' Pilpré # 2001/06/15 # Great earth maps available from http://apollo.spaceports.com/~jhasting/earth.html # A jcwren's monkmap compliant map can be found at # http://www.pilpre.com/briac/small_earth.jpg #drawmap.pl -i=northam10k.jpg -o=monkmap_northam.jpg -x=-1280 -y=-896 -m ./monks.xml -d cross.png -w 10800 -h 5400 #drawmap.pl -i=europe10k.jpg -o=monkmap_europe.jpg -x=-4880 -y=-695 -m ./monks.xml -d cross.png -w 10800 -h 5400 #drawmap.pl -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 width>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,585); die "Uhoh" unless rectangles_intersect(598,572,640,585, 589,573,645,586); # 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 site. # ( 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}->{latitude}, $ref->{monk}->{$_}->{location}->{longitude}, )); } # 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 density 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],$monks{$_}->[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) && between(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, $height); # Tweak the x/y to fit the picture $x += $offsetx; $y += $offsety; $points{$_} = [$x-$f, $y-$f, $x+$f, $y+$f]; # store the current pos $boxes{"__$_"} = [$x-$f, $y-$f, $x+$f, $y+$f]; # store the current 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, $height); # 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 caption # 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 true 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 caption 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 rectangle 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 some 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 drawmap.pl -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 zooming) -h --height : Height of the original whole earth map __USAGE__ die "\n"; } __DATA__