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)>

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://89635]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther 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?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.