Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

drawmap.pl

by OeufMayo (Curate)
on Jun 19, 2001 at 18:10 UTC ( [id://89635]=sourcecode: print w/replies, xml ) Need Help??
Category: PerlMonks Related Scripts
Author/Contact Info Briac Pilpré
Description: see node drawmap.pl - Spot The Monk! - 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!) 
#!/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/~jhasti
+ng/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 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}->{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,$heigh
+t-$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 mo
+nk is too close
            find_intersect(\%boxes, $_, @box)     # or the place has b
+een 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+($radi
+us * 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="$outpu
+t" /></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=$_" sha
+pe="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_t
+op) ||
            point_in_rectangle($a_lft,$a_top,$a_rgt,$a_btm,$b_rgt,$b_t
+op) ||
            point_in_rectangle($a_lft,$a_top,$a_rgt,$a_btm,$b_lft,$b_b
+tm) ||
            point_in_rectangle($a_lft,$a_top,$a_rgt,$a_btm,$b_rgt,$b_b
+tm) ||
            point_in_rectangle($b_lft,$b_top,$b_rgt,$b_btm,$a_lft,$a_t
+op) ||
            point_in_rectangle($b_lft,$b_top,$b_rgt,$b_btm,$a_rgt,$a_t
+op) ||
            point_in_rectangle($b_lft,$b_top,$b_rgt,$b_btm,$a_lft,$a_b
+tm) ||
            point_in_rectangle($b_lft,$b_top,$b_rgt,$b_btm,$a_rgt,$a_b
+tm) ||
            # Or an intersection where no corner is within the other r
+ectangle
            (
                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 zoo
+ming)
 -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)>

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://89635]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2025-06-17 01:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found
    Notices?
    • erzuuli‥ Anonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.