sourcecode
OeufMayo
<code>
#!/usr/bin/perl -w
#
# drawmap - spot the monk!
# Briac 'OeufMayo' Pilpré
# 2001/06/15
# munged by Max 'Corion' Maischein
# 2001/06/17
# 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
# jcwren's monks.xml file available at:
# http://www.tinymicros.com/pm/monks.xml
#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 -H monkmap_europe.html
#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.04;
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 H=s xml>m dot>d width>w height>h input>i output>o offsetx>x offsety>y nocaption>C html>H');
# Fetch the command line parameters
my ($input, $output, $offsetx, $offsety, $dot, $xml, $width, $height, $nocaption, $html);
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';
if ($option eq 'H') {
$html = $value;
$nocaption = 0;
};
}
Getopt::Mixed::cleanup();
&usage unless ($input && $output);
$offsetx ||= 0;
$offsety ||= 0;
my (%monks, %href);
# 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) {
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);
if ($html){
open HTML, "> $html" or die $!;
print HTML <<"__HTML__";
<html>
<head>
<title>drawmap - $output</title>
</head>
<body>
<h1>drawmap - $output</h1>
<p><img border="0" src="$output" usemap="#drawmap" alt="$output" /></p>
<map name="drawmap">
__HTML__
foreach (keys %boxes){
print HTML qq'\t\t<area ';
print HTML 'coords="', join( ',', @{$boxes{$_}} ), '" ';
s/^__//;
print HTML qq'href="http://www.perlmonks.org/index.pl?node=$_" shape="rect" alt="$_" />\n';
}
print HTML '</map>\n</body>\n</html>';
}
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
-H --html : Generate a HTML with an IMAGEMAP (cancels the -C)
requires the name of the html file to create
-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__
<!-- monks.xml DTD -->
<!ELEMENT monkmap (monk+)>
<!ATTLIST monk source CDATA #REQUIRED>
<!ELEMENT monk (name, location)>
<!ATTLIST monk id CDATA #REQUIRED>
<!ELEMENT name (#PCDATA)>
<!ELEMENT location (latitude, longitude)>
<!ELEMENT latitude (#PCDATA)>
<!ELEMENT longitude (#PCDATA)>
</code>
see node [id://88780] - The code is posted here just for ease of use and update. (no need to vote on this, got enough XP with the first one!) <!-- Allright, ++ it if you really want to spend your votes, I won't mmind too much -->
Perlmonks.org Related Scripts
Briac Pilpré