#!/usr/bin/perl -w

#========================================================================
# This is the grand final wonderful super-duper map-drawing application
# for L579, Project 4 (Spring 2005).  It implements a simple scripting
# language that describes how to draw the final visualization, thus
# allowing the hapless developers to maintain the script rather than
# this application.
#
# The scripting language is marginally documented below:
#
#   ABS_NODE <color_in> <color_out> <size> <region> <point>
#   ABS_PATH <start> <end> <color> <width> <region> <point1> ...
#   ARC <xc> <yc> <width> <height> <start> <end>
#   BOX <x1> <y1> <x2> <y2>
#   COLOR <name> <r> <g> <b> {<a>}
#   DRAW_LABEL <color> <size>
#   DRAW_LOC <color_in> <color_out> <min_size> <max_size>
#   DRAW_PATH <color> <min_size> <max_size>
#   FILL_AREA <region> <point> <fill_color>
#   FILL_BOUND <region> <point> <fill_color> <border_color>
#   FONT <name> <path>
#   GCIRCLE <lon1> <lat1> <lon2> <lat2>
#   GRADIENT <name> <r1> <g1> <b1> <r2> <g2> <b2> {<a>}
#   IMAGE <path> <x1> <y1> <x2> <y2>
#   LABEL <region> <loc> <position> <text>
#   LINE <x1> <y1> <x2> <y2>
#   PALETTE <year> <color>
#   PATH <start> <end> <region> <point1> ...
#   PEN <color> <width> <smooth>
#   PLOT <region> <path>
#   RECT <x1> <y1> <x2> <y2>
#   REGION <name> <x1> <y1> <x2> <y2> <lon1> <lat1> <lon2> <lat2>
#   SET <name> <value>
#   TEXT <x> <y> <font> <size> <justify> <string>
#   ZIP <path>
#
# Written by Mark Meiss and Heather Roinestad, 2005-04-11.
# Last modified: 2005-08-12.
#========================================================================

use GD;
use Cwd;
use strict;


#------------------------------------------------------------------------
# Global variables.
#------------------------------------------------------------------------

my %map_color   = ();  # key: color name,           value: GD color
my %map_edge    = ();  # key: origin + destination, value: hash with 'tally' and 'when' keys
my %map_font    = ();  # key: font name,            value: path to TTF file
my @list_label  = ();  # key: <N/A>,                value: label informaton (see &command_label)
my %map_node    = ();  # key: location,             value: hash with 'tally' and 'when' keys
my %map_palette = ();  # key: year,                 value: GD color
my %map_pen     = ();  # key: (pen attributes),     value: (various)
my %map_region  = ();  # key: region name,          value: region boundary data
my %map_var     = ();  # key: variable name,        value: variable value
my %map_zip     = ();  # key: zip code,             value: location


my %command_table = ( ABS_NODE   => \&command_abs_node,  ABS_PATH   => \&command_abs_path,
		      ARC        => \&command_arc,       BOX        => \&command_box,
		      COLOR      => \&command_color,     DRAW_LABEL => \&command_draw_label,
		      DRAW_LOC   => \&command_draw_loc,  DRAW_PATH  => \&command_draw_path,
		      FILL_AREA  => \&command_fill_area, FILL_BOUND => \&command_fill_bound,
		      FONT       => \&command_font,      GCIRCLE    => \&command_gcircle,
		      GRADIENT   => \&command_gradient,
		      IMAGE      => \&command_image,     LABEL      => \&command_label,
		      LINE       => \&command_line,      PALETTE    => \&command_palette,
		      PATH       => \&command_path,      PEN        => \&command_pen,
		      PLOT       => \&command_plot,      RECT       => \&command_rect,
		      REGION     => \&command_region,    SET        => \&command_set,
		      TEXT       => \&command_text,      ZIP        => \&command_zip );

my $PI            = 3.14159265358979323846;
my $convert_path  = '/usr/local/bin/convert';  # part of ImageMagick

my ($path_map, $size_x, $size_y, $path_img, $image, $line, $command, @args);
my ($page_x, $page_y, %bound);



#====================================================================================================
# MAIN PROGRAM.
#====================================================================================================

# present usage information if necessary
unless (@ARGV == 6) {
    print STDERR <<"END";
Usage: $0 [path to .cz file] [x-size] [y-size] [x-page] [y-page] [target path]

Format of x-size and y-size is either <size> or <page-size>:<total-size>:<overlap>.

  <page-size>  is the size in pixels of a single page.
  <total-size> is the size in pixels of the entire multi-page map.
  <overlap>    is the number of pixels by which pages should overlap one another.

x-page and y-page are zero-indexed.
END
    exit;
}

($path_map, $size_x, $size_y, $page_x, $page_y, $path_img) = @ARGV;

# figure out the x-bounds of the page being rendered
if ($size_x =~ /(\d+):(\d+):(\d+)/) {
    my ($this_x, $count_page_x, $overlap) = ($1, $2, $3);
    $bound{x1} = ($this_x * $page_x) - ($overlap * $page_x);
    $bound{x2} = $bound{x1} + $this_x - 1;
    $size_x    = ($count_page_x * $this_x) - ($overlap * ($count_page_x - 1));
} else {
    $bound{x1} = 0;
    $bound{x2} = $size_x - 1;
}

# figure out the y-bounds of the page being rendered
if ($size_y =~ /(\d+):(\d+):(\d+)/) {
    my ($this_y, $count_page_y, $overlap) = ($1, $2, $3);
    $bound{y1} = ($this_y * $page_y) - ($overlap * $page_y);
    $bound{y2} = $bound{y1} + $this_y - 1;
    $size_y    = ($count_page_y * $this_y) - ($overlap * ($count_page_y - 1));
} else {
    $bound{y1} = 0;
    $bound{y2} = $size_y - 1;
}

# create the image object
GD::Image->trueColor(1);
$image = new GD::Image($bound{x2} - $bound{x1} + 1, $bound{y2} - $bound{y1} + 1);
$image->alphaBlending(1);
printf "Image size: %d x %d\n", $bound{x2} - $bound{x1} + 1, $bound{y2} - $bound{y1} + 1;

# open the script file
open IN, $path_map;

# for each line in the script
while (defined ($line = <IN>)) {

    # skip blank lines and comments
    chomp $line;
    $line =~ s/^\s+//o;
    $line =~ s/\s+$//o;
    next if ($line eq '') || ($line =~ /^#/);

    # parse the line into its parts
    ($command, @args) = split /\s+/, $line;
    $command = uc $command;

    # dispatch on the command
    die "Unknown command: $command\n" unless defined $command_table{$command};
    &{$command_table{$command}}(@args);
}

# close the script file
close IN;

# write out the image
open OUT, "> $path_img";
binmode OUT;
print OUT $image->png();
close OUT;



#====================================================================================================
# COMMAND ROUTINES.
#====================================================================================================

#------------------------------------------------------------------------
# ABS_NODE <color_in> <color_out> <size> <region> <point>
#------------------------------------------------------------------------
sub command_abs_node {

    # get a hold of my parameters
    my ($color_in, $color_out, $size, $region, $point) = @_;

    # declare local variables
    my ($lon, $lat, $tag);

    # map the point to lat/lon
    ($lon, $lat) = &expand_location($point);
    $tag = "$lon $lat";

    # add the override data
    $map_node{$tag}->{tally}->{$region}++;
    $map_node{$tag}->{color_in}  = $map_color{$color_in};
    $map_node{$tag}->{color_out} = $map_color{$color_out};
    $map_node{$tag}->{size}      = &var($size);
}


#------------------------------------------------------------------------
# ABS_PATH <start> <end> <color> <width> <region> <point1> ...
#------------------------------------------------------------------------
sub command_abs_path {

    # get a hold of my parameters
    my ($start, $end, $color, $width, $region, @points) = @_;

    # declare local variables
    my ($point, @list, $i, $tag, $year1, $year2, $lon, $lat);

    # figure out the year associated with the trip (start of trip gets priority for now)
    ($year1) = $start =~ /^(\d+)/;
    ($year2) = $end   =~ /^(\d+)/;
    $year1 = $year2;

    # map each point to lat/lon
    foreach $point (@points) {
	($lon, $lat) = &expand_location($point);
	push @list, ((defined $lon) ? [ $lon, $lat ] : undef);
    }

    # for each edge in the path
    for ($i = -1; $i < (@list - 1); ++$i) {

	# skip edges with an undefined origin or destination
	next unless defined $list[$i] && defined $list[$i+1];

	# figure out the tag for the edge (origin location + destination location)
	$tag = "$list[$i]->[0] $list[$i]->[1] $list[$i+1]->[0] $list[$i+1]->[1]";

	# store the absolute color and width data if there is any
	$map_edge{$tag}->{color} = $map_color{$color} if defined $color;
	$map_edge{$tag}->{width} = &var($width)       if defined $width;

	# add to the tally and log the time
	$map_edge{$tag}->{tally}->{$region}++;
	push @{$map_edge{$tag}->{when}->{$region}}, $year1;
    }

    # for each node in the path
    foreach $point (@list) {

	# skip nodes with an undefined location
	next unless defined $point;

	# figure out the tag for the node (location)
	$tag = "$point->[0] $point->[1]";

	# add to the tally and log the time
	$map_node{$tag}->{tally}->{$region}++;
	push @{$map_node{$tag}->{when}->{$region}}, $year1;
    }
}


#------------------------------------------------------------------------
# ARC <xc> <yc> <width> <height> <start> <end>
#
# Draws an arc in the image in pretty much the way you'd expect.
#------------------------------------------------------------------------
sub command_arc {

    # get a hold of my parameters
    my ($xc, $yc, $width, $height, $start, $end) = @_;

    # draw the arc
    $image->arc(&ix(&var($xc)), &iy(&var($yc)), &ix(&var($width)), &iy(&var($height)), &var($start), &var($end), &set_pen()->{object});
}


#------------------------------------------------------------------------
# BOX <x1> <y1> <x2> <y2>
#
# Command to draw a (hollow) box with corners at (x1, y1) and (x2, y2).
#------------------------------------------------------------------------
sub command_box {

    # get a hold of my parameters
    my ($x1, $y1, $x2, $y2) = @_;

    # draw the rectangle
    $image->rectangle(&ix(&var($x1)), &iy(&var($y1)), &ix(&var($x2)), &iy(&var($y2)), &set_pen()->{object});
}


#------------------------------------------------------------------------
# COLOR <name> <r> <g> <b> {<a>}
#
# Command to define a new color and associate it with a name.
#------------------------------------------------------------------------
sub command_color {

    # get a hold of my parameters
    my ($name, $r, $g, $b, $a) = @_;

    # handle alpha colors differently
    if (defined $a) {

	# translate from [0,1] to [127,0]
	$a = int((1.0 - &var($a)) * 127);

	# create the color
	$map_color{$name}->{object} = $image->colorAllocateAlpha(&var($r), &var($g), &var($b), $a);

    } else {

	# create the color
	$map_color{$name}->{object} = $image->colorAllocate(&var($r), &var($g), &var($b));
    }
}


#------------------------------------------------------------------------
# DRAW_LABEL <font> <size> <color>
#
# Draws the registered labels on the map, using the given font, size,
# and color.  The size is specified in proportion to the drawing as a
# whole.
#------------------------------------------------------------------------
sub command_draw_label {

    # get a hold of my parameters
    my ($font, $size, $color) = @_;

    # declare local variables
    my ($label, $point, @bounds, $x, $y, $label_x, $label_y);

    # look up the attributes
    $font  = $map_font{$font};
    $color = $map_color{$color};
    $point = $size_y * &var($size);

    # for each label
    foreach $label (@list_label) {

	# figure out the bounds of the text
	@bounds  = GD::Image->stringFT($color->{object}, $font, $point, 0, 0, 0, $label->{text});
	$label_x = (&max($bounds[2], $bounds[4]) - &min($bounds[0], $bounds[6])) / $size_x;
	$label_y = (&max($bounds[1], $bounds[3]) - &min($bounds[5], $bounds[7])) / $size_y;

	# find the projection of the location
	($x, $y) = &project($map_region{$label->{region}}, $label->{lon}, $label->{lat});
	     if ($label->{position} eq 'UL') {  $x = $x - $label_x - 0.001;  $y = $y - 0.001;
	} elsif ($label->{position} eq 'UR') {  $x = $x + 0.001;             $y = $y - 0.001;
	} elsif ($label->{position} eq 'DL') {  $x = $x - $label_x - 0.001;  $y = $y + $label_y + 0.001;
	} elsif ($label->{position} eq 'DR') {  $x = $x + 0.001;             $y = $y + $label_y + 0.001;
	} elsif ($label->{position} eq 'C')  {  $x = $x - ($label_x / 2);    $y = $y + ($label_y / 2); }

	# draw the label
	$image->stringFT($color->{object}, $font, $point, 0, &ix($x), &iy($y), $label->{text});
    }

    # clear out the label list
    @list_label = ();
}


#------------------------------------------------------------------------
# DRAW_LOC <color_in> <color_out> <min_size> <max_size>
#
# Draws the locations (nodes) on the map.
#------------------------------------------------------------------------
sub command_draw_loc {

    # get a hold of my parameters
    my ($color_in, $color_out, $min_size, $max_size) = @_;

    # declare local variables
    my ($max, $region, $node, $size, $lon, $lat, $x, $y, @list, $count, $this_in, $this_out);

    # for each region in the map as a whole
    $count = 0;
    foreach $region (keys %map_region) {

	# find the maximum number of visits
	@list = sort { $b <=> $a } map { $map_node{$_}->{tally}->{$region} || 0 } keys %map_node;
	$max = $list[1] || 1;

	# for each node to draw
	foreach $node (keys %map_node) {

	    # skip this node if there's no data
	    next unless defined $map_node{$node}->{tally}->{$region};

	    # figure out the size
	    if (defined $map_node{$node}->{size}) {
		$size = $map_node{$node}->{size};
	    } else {
		$size = $min_size + ($map_node{$node}->{tally}->{$region} * ($max_size - $min_size) / $max);
		$size = $max_size if $size > $max_size;
	    }

	    # figure out the coordinates
	    ($lon, $lat) = split /\s+/, $node;
	    ($x, $y) = &project($map_region{$region}, $lon, $lat);

	    # figure out the colors
	    $this_in  = (defined $map_node{$node}->{color_in})  ? $map_node{$node}->{color_in}  : $map_color{$color_in};
	    $this_out = (defined $map_node{$node}->{color_out}) ? $map_node{$node}->{color_out} : $map_color{$color_out};

	    # and draw
	    $image->setThickness(1);
	    $image->filledEllipse(&ix($x), &iy($y), $size, $size, $this_in ->{object});
	    $image->ellipse      (&ix($x), &iy($y), $size, $size, $this_out->{object});
	    ++$count;
	}
    }

    # report on what we did
    print "Final tally: $count nodes drawn.\n";
}


#------------------------------------------------------------------------
# DRAW_PATH <color> <min_size> <max_size>
#
# Draws the trips (edges) on the map.  The given color is used only if
# there are no palette entries for the year of a trip.
#------------------------------------------------------------------------
sub command_draw_path {

    # get a hold of my parameters
    my ($color, $min_size, $max_size) = @_;

    # declare local variables
    my ($region, $max, $lon1, $lat1, $lon2, $lat2, $x1, $y1, $x2, $y2, $size, $edge);
    my (@list, $i, $track, @work, $item, $width, $color2, $count);

    # for each region in the map as a whole
    $count = 0;
    foreach $region (keys %map_region) {

	# find the maximum number of trips
	@list = sort { $b <=> $a } map { $map_edge{$_}->{tally}->{$region} || 0 } keys %map_edge;
	$max = $list[1] || 1;

	# for each edge to draw
	foreach $edge (keys %map_edge) {

	    # skip this edge if there's no data
	    #print "$region [$max] $edge\n";
	    next unless defined $map_edge{$edge}->{tally}->{$region};

	    # figure out the size
	    $size = $min_size + ($map_edge{$edge}->{tally}->{$region} * ($max_size - $min_size) / $max);
	    $size = $max_size if $size > $max_size;

	    # for each track
	    @list = sort { $a <=> $b } @{$map_edge{$edge}->{when}->{$region}};
	    for ($i = 0; $i < @list; ++$i) {

		# figure out the coordinates and store them
		($lon1, $lat1, $lon2, $lat2) = split /\s+/, $edge;
		$track  = $i - ((@list - 1) / 2.0);
		$width  = (defined $map_edge{$edge}->{width}) ? $map_edge{$edge}->{width} : &max(int(10 - 2 * @list), 3);
		$color2 = (defined $map_palette{$list[$i]}) ? $map_palette{$list[$i]} : $map_color{$color};
		$color2 = (defined $map_edge{$edge}->{color}) ? $map_edge{$edge}->{color} : $color2;
		push @work, [ $list[$i], $region, $lon1, $lat1, $lon2, $lat2, $track, $width, $color2 ];
	    }
	}

	# sort the edges by year
	@work = sort { $a->[0] <=> $b->[0] } @work;

	# and actually draw them
	foreach $edge (@work) {
	    $map_pen{width} = $edge->[7];
	    $map_pen{color} = $edge->[8];
	    &command_gcircle($edge->[1], $edge->[2], $edge->[3], $edge->[4], $edge->[5], $edge->[6]);
	    ++$count;
	}
    }

    # report on what we did
    print "Final tally: $count edges drawn.\n";
}


#------------------------------------------------------------------------
# FILL_AREA <region> <point> <fill_color>
#------------------------------------------------------------------------
sub command_fill_area {

    # get a hold of my parameters
    my ($region, $point, $fill_color) = @_;

    # declare local variables
    my ($lon, $lat, $x, $y);

    # map the point to an image location
    ($lon, $lat) = &expand_location($point);
    ($x, $y)     = &project($map_region{$region}, $lon, $lat);

    # attempt the fill
    $image->fill(&ix($x), &iy($y), $map_color{$fill_color}->{object});
}


#------------------------------------------------------------------------
# FILL_BOUND <region> <point> <fill_color> <border_color>
#------------------------------------------------------------------------
sub command_fill_bound {

    # get a hold of my parameters
    my ($region, $point, $fill_color, $border_color) = @_;

    # declare local variables
    my ($lon, $lat, $x, $y);

    # map the point to an image location
    ($lon, $lat) = &expand_location($point);
    ($x, $y)     = &project($map_region{$region}, $lon, $lat);

    # attempt the fill
    $image->fillToBorder(&ix($x), &ix($y), $map_color{$fill_color}->{object}, $map_color{$border_color}->{object});
}


#------------------------------------------------------------------------
# FONT <name> <path>
#
# Associates the given name with the given font, which is specified
# as a path to a True Type font file.
#------------------------------------------------------------------------
sub command_font {

    # get a hold of my parameters
    my ($name, @rest) = @_;

    # declare local variables
    my ($dir);

    # store the path
    $dir = cwd();
    $map_font{$name} = $dir . '/' . join(' ', @rest);
}


#------------------------------------------------------------------------
# GCIRCLE <region> <lon1> <lat1> <lon2> <lat2> <track>
#
# Draws a great circle route in the given region, extending from
# (lon1, lat1) to (lon2, lat2).  [track] specifies a positive or
# negative maximam displacement in radians from the great circle; it
# is used to produce paths with the same endpoints but with slightly
# different courses.
#------------------------------------------------------------------------
sub command_gcircle {

    # get a hold of my parameters
    my ($region, $lon1, $lat1, $lon2, $lat2, $track) = @_;

    # declare local variables
    my ($rlon1, $rlat1, $rlon2, $rlat2, $rdist, $rcourse, $d, $x_scale, $y_scale, $scale);
    my ($plon1, $plat1, $plon2, $plat2, $x1, $y1, $x2, $y2, $factor, $color, $r, $g, $b);

    # convert the endpoints to radians
    $rlon1 = &deg_to_rad(&var($lon1));
    $rlat1 = &deg_to_rad(&var($lat1));
    $rlon2 = &deg_to_rad(&var($lon2));
    $rlat2 = &deg_to_rad(&var($lat2));

    # figure out the distance in radians and the true course
    $rdist   = &distance($rlon1, $rlat1, $rlon2, $rlat2);
    return if $rdist < 0.0000001;
    $rcourse = &course  ($rlon1, $rlat1, $rlon2, $rlat2, $rdist);

    # figure out the degree increment
    $region  = $map_region{$region};
    $x_scale = &deg_to_rad(abs($region->{lon2} - $region->{lon1})) / (abs($region->{x2} - $region->{x1}) * $size_x);
    $y_scale = &deg_to_rad(abs($region->{lat2} - $region->{lat1})) / (abs($region->{y2} - $region->{y1}) * $size_y);
    $scale   = 6 * (($x_scale > $y_scale) ? $x_scale : $y_scale);

    # initialize the last-point variables
    $plon1 = $rlon1;
    $plat1 = $rlat1;

    # plot the course
    for ($d = 0; $d <= $rdist; $d += $scale) {

	# figure out the ending point for this segment
	($plon2, $plat2) = &destination($rlon1, $rlat1, $rcourse, $d);

	# move a little bit perpendicular to it
	$factor = 1.0 - 4.0 * (abs(($d / $rdist) - 0.5) ** 2);
	($plon2, $plat2) = &destination($plon2, $plat2, $rcourse + ($PI / 2), $factor * $track * $scale);

	# figure out the endpoints in pixels
	($x1, $y1) = &project($region, &rad_to_deg($plon1), &rad_to_deg($plat1));
	($x2, $y2) = &project($region, &rad_to_deg($plon2), &rad_to_deg($plat2));

	# draw the segment
	$color = &set_pen();
	if ($color->{gradient}) {
	    $r = $color->{r}->[0] + ($d / $rdist) * ($color->{r}->[1] - $color->{r}->[0]);
	    $g = $color->{g}->[0] + ($d / $rdist) * ($color->{g}->[1] - $color->{g}->[0]);
	    $b = $color->{b}->[0] + ($d / $rdist) * ($color->{b}->[1] - $color->{b}->[0]);
	    if (defined $color->{a}) {
		$image->line(&ix($x1), &iy($y1), &ix($x2), &iy($y2), $image->colorAllocateAlpha($r, $g, $b, $color->{a}));
	    } else {
		$image->line(&ix($x1), &iy($y1), &ix($x2), &iy($y2), $image->colorAllocate($r, $g, $b));
	    }
	} else {
	    $image->line(&ix($x1), &iy($y1), &ix($x2), &iy($y2), $color->{object});
	}

	# update the last point
	$plon1 = $plon2;
	$plat1 = $plat2;
    }
}


#------------------------------------------------------------------------
# GRADIENT <name> <r1> <g1> <b1> <r2> <g2> <b2> {<a>}
#
# Registers a gradient color, which is different from a normal color
# when it is applied to a path.  In this case, the color will vary
# linearly from the first RGB triple to the second RGB triple over the
# course of the path.  In all other contexts, the gradient will just
# appear as the first RGB triple.
#------------------------------------------------------------------------
sub command_gradient {

    # get a hold of my parameters
    my ($name, $r1, $g1, $b1, $r2, $g2, $b2, $a) = @_;

    # create the basic color
    &command_color($name, $r1, $g1, $b1, $a);

    # add the gradient information
    $map_color{$name}->{object}   = $image->colorAllocate(&var($r1), &var($g1), &var($b1));
    $map_color{$name}->{gradient} = 1;
    $map_color{$name}->{r}        = [ &var($r1), &var($r2) ];
    $map_color{$name}->{g}        = [ &var($g1), &var($g2) ];
    $map_color{$name}->{b}        = [ &var($b1), &var($b2) ];

    # add alpha information if necessary
    if (defined $a) {
	$map_color{$name}->{a} = int((1.0 - &var($a)) * 127);
    }
}


#------------------------------------------------------------------------
# IMAGE <path> <x1> <y1> <x2> <y2>
#
# Loads the bitmap image stored at the given path and draws it in the
# given bounds, scaling the image if necessary.
#------------------------------------------------------------------------
sub command_image {

    # get a hold of my parameters
    my ($path, $x1, $y1, $x2, $y2) = @_;

    # declare local variables
    my ($image_x, $image_y, $png_path, $png_image);

    # dereference any variables used
    $path = &var($path);
    $x1   = &var($x1);
    $y1   = &var($y1);
    $x2   = &var($x2);
    $y2   = &var($y2);

    # find the dimensions of the image
    $image_x = int(&ix($x2) - &ix($x1) + 0.5);
    $image_y = int(&iy($y2) - &iy($y1) + 0.5);

    # try to convert the image to a .PNG file of the proper size
    $png_path = "Chizu-$$.png";
    print join(' ', ($convert_path, $path, '-resize', "$image_x" . 'x' . "$image_y" . '!', $png_path), "\n");
    system($convert_path, $path, '-resize', "$image_x" . 'x' . "$image_y" . '!', $png_path);

    # read in the file
    $png_image = GD::Image->newFromPng($png_path);

    # copy the image data
    $image->copy($png_image, &ix($x1), &iy($y1), 0, 0, $image_x, $image_y);

    # and destroy the copied image
    $png_image = undef;
    unlink $png_path;
}


#------------------------------------------------------------------------
# LABEL <region> <loc> <position> <text>
#
# Registers a label for the given geographic point in a map region.
# [position] is one of "C", "UL", "UR", "DL", "DR", depending on where
# you want the label to appear.
#------------------------------------------------------------------------
sub command_label {

    # get a hold of my parameters
    my ($region, $loc, $position, @rest) = @_;

    # declare local variables
    my ($lat, $lon);

    # store the label information
    ($lon, $lat) = &expand_location($loc);
    push @list_label, { region => $region, lon => $lon, lat => $lat, position => uc($position), text => join(' ', @rest) };
}


#------------------------------------------------------------------------
# LINE <x1> <y1> <x2> <y2>
#
# Command to draw a line from (x1, y1) to (x2, y2).
#------------------------------------------------------------------------
sub command_line {

    # get a hold of my parameters
    my ($x1, $y1, $x2, $y2) = @_;

    # draw the line
    $image->line(&ix(&var($x1)), &iy(&var($y1)), &ix(&var($x2)), &iy(&var($y2)), &set_pen()->{object});
}


#------------------------------------------------------------------------
# PALETTE <year> <color>
#
# Associates the given color with the given year; this information
# will be used in drawing locations and paths.
#------------------------------------------------------------------------
sub command_palette {

    # get a hold of my parameters
    my ($year, $color) = @_;

    # store the mapping
    $map_palette{$year} = $map_color{$color};
}


#------------------------------------------------------------------------
# PATH <start> <end> <region> <point1> ...
#
# Logs a travel path defined by the given points.  This is the main
# command for accumulating data for trip itineraries.
#------------------------------------------------------------------------
sub command_path {

    # get a hold of my parameters
    my ($start, $end, $region, @points) = @_;

    # dispatch to the ABS_PATH command
    &command_abs_path($start, $end, undef, undef, $region, @points);
}


#------------------------------------------------------------------------
# PEN <color> <width> <smooth>
#
# Sets the current drawing state to use the given color, width, and
# smoothing (anti-aliasing) setting.
#------------------------------------------------------------------------
sub command_pen {

    # get a hold of my parameters
    my ($color, $width, $smooth) = @_;

    # set the pen state
    $map_pen{color}  = $map_color{$color};
    $map_pen{width}  = $width;
    $map_pen{smooth} = ($smooth =~ /^yes$/i) ? 1 : 0;
}


#------------------------------------------------------------------------
# PLOT <region> <file>
#
# Plots the polygons in the given file in the given region, using the
# default projection.
#------------------------------------------------------------------------
sub command_plot {

    # get a hold of my parameters
    my ($region, $file) = @_;

    # declare local variables
    my ($color, $line, $state, $lat, $lon, $last_x, $last_y, $x, $y);

    # look up the region and set our drawing parameters
    $region = $map_region{$region};
    $color  = &set_pen();

    # set the clipping region
    $image->clip(&ix($region->{x1}), &iy($region->{y1}), &ix($region->{x2}), &iy($region->{y2}));

    # open the polygon file
    open POLY, $file;
    $state = &STATE_READY;

    # process the polygons
    while (defined ($line = <POLY>)) {

	# trim the line
	chomp $line;
	$line =~ s/^\s+//o;
	$line =~ s/\s+$//o;

	# the ready state: start a new polyogn
	if ($state == &STATE_READY) {
	    last if $line eq 'END';
	    $state = &STATE_FIRST;

	# the first-point state: just project and store the point
	} elsif ($state == &STATE_FIRST) {
	    ($lat, $lon) = split /\s+/, $line;
	    ($last_x, $last_y) = &project($region, $lat, $lon);
	    $state = &STATE_ACTIVE;

	# the active state: draw a new line in the polygon
	} else {
	    if ($line eq 'END') {
		$state = &STATE_READY;
	    } else {
		($lat, $lon) = split /\s+/, $line;
		($x, $y) = &project($region, $lat, $lon);
		$image->line(&ix($last_x), &iy($last_y), &ix($x), &iy($y), $color->{object});
		$last_x = $x;
		$last_y = $y;
	    }
	}
    }

    # close the polygon file
    close POLY;

    # remove the clipping region
    $image->clip(0, 0, $bound{x2} - $bound{x1}, $bound{y2} - $bound{y1});
}

sub STATE_READY  { 0 }
sub STATE_FIRST  { 1 }
sub STATE_ACTIVE { 2 }


#------------------------------------------------------------------------
# RECT <x1> <y1> <x2> <y2>
#
# Command to draw a solid rectangle with (x1, y1) at the upper left
# and (x2, y2) at the lower right.
#------------------------------------------------------------------------
sub command_rect {

    # get a hold of my parameters
    my ($x1, $y1, $x2, $y2) = @_;

    # draw the rectangle
    $image->filledRectangle(&ix(&var($x1)), &iy(&var($y1)), &ix(&var($x2)), &iy(&var($y2)), &set_pen()->{object});
}


#------------------------------------------------------------------------
# REGION <name> <x1> <y1> <x2> <y2> <lon1> <lat1> <lon2> <lat2>
#
# Command to specify a mapping region with boundary corners (x1, y1)
# and (x2, y2) in the virtual world and (lon1, lat1), (lon2, lat2) in
# the physical world.
#------------------------------------------------------------------------
sub command_region {

    # get a hold of my parameters
    my ($name, $x1, $y1, $x2, $y2, $lon1, $lat1, $lon2, $lat2) = @_;

    # store the region
    $map_region{$name} = { x1   => &var($x1),   y1   => &var($y1),   x2   => &var($x2),   y2   => &var($y2),
			   lon1 => &var($lon1), lat1 => &var($lat1), lon2 => &var($lon2), lat2 => &var($lat2) };
}


#------------------------------------------------------------------------
# SET <name> <value>
#
# Command to associate a name with a numeric value.
#------------------------------------------------------------------------
sub command_set {

    # get a hold of my parameters
    my ($name, $value) = @_;

    # store the value
    $map_var{$name} = $value;
}


#------------------------------------------------------------------------
# TEXT <x> <y> <font> <size> <justify> <string>
#
# Draws a string at the given location, using the given size, which is
# expressed as a proportion of the image size rather than an absolute
# value in points.  [justify] is either 'left' or 'right', which have
# the obvious meanings.
#------------------------------------------------------------------------
sub command_text {

    # get a hold of my parameters
    my ($x, $y, $font, $size, $justify, @parts) = @_;

    # declare local variables
    my ($string, $point, @bounds, $text_x);

    # figure out the string and point size
    $string = join ' ', @parts;
    $point  = $size_y * &var($size);

    # draw the string
    if ($justify eq 'left') {
	$image->stringFT($map_pen{color}->{object}, $map_font{$font}, $point, 0, &ix(&var($x)), &iy(&var($y)), $string);
    } elsif ($justify eq 'right') {
	@bounds = GD::Image->stringFT($map_pen{color}->{object}, $map_font{$font}, $point, 0, 0, 0, $string);
	$text_x = (&max($bounds[2], $bounds[4]) - &min($bounds[0], $bounds[6])) / $size_x;
	$image->stringFT($map_pen{color}->{object}, $map_font{$font}, $point, 0, &ix(&var($x) - $text_x), &iy(&var($y)), $string);
    }
}


#------------------------------------------------------------------------
# ZIP <path>
#
# Command to load ZIP location data from the given file.
#------------------------------------------------------------------------
sub command_zip {

    # get a hold of my parameters
    my ($path) = @_;

    # declare local variables
    my ($line, $zip, $lat, $lon);

    # read in the data
    open ZIP, $path;
    while (defined ($line = <ZIP>)) {
	($zip, $lon, $lat) = split /\s+/, $line;
	$map_zip{$zip} = [ $lon, $lat ];
    }
}



#====================================================================================================
# LIBRARY ROUTINES.
#====================================================================================================

#------------------------------------------------------------------------
# double acos(x);
#
# Returns arccos(x) in radians.
#------------------------------------------------------------------------
sub acos {

    # get a hold of my parameters
    my ($x) = @_;

    # calculate the value
    return atan2(sqrt(abs(1.0 - ($x * $x))), $x);
}


#------------------------------------------------------------------------
# double asin(x);
#
# Returns arcsin(x) in radians.
#------------------------------------------------------------------------
sub asin {

    # get a hold of my parameters
    my ($x) = @_;

    # declare local variables
    my ($root);

    # calculate the value
    return atan2($x, sqrt(abs(1.0 - ($x * $x))));
}


#------------------------------------------------------------------------
# double course(rlon1, rlat1, rlon2, rlat2, rdist);
#
# Given two spherical points specified as longitude/latitude pairs in
# radians, and the spherical distance in radians between them, returns
# the true course from the first points to the second.
#------------------------------------------------------------------------
sub course {

    # get a hold of my parameters
    my ($rlon1, $rlat1, $rlon2, $rlat2, $rdist) = @_;

    # declare local variables
    my ($temp);

    # calculate the value
    $temp = &acos((sin($rlat2) - sin($rlat1) * cos($rdist)) / (sin($rdist) * cos($rlat1)));
    return (sin($rlon2 - $rlon1) < 0) ? $temp : (2 * $PI - $temp);
}


#------------------------------------------------------------------------
# double deg_to_rad(deg);
#
# Converts a value from degrees to radians.
#------------------------------------------------------------------------
sub deg_to_rad {

    # get a hold of my parameters
    my ($deg) = @_;

    # return the value in degrees
    return ($deg * ($PI / 180.0));
}


#------------------------------------------------------------------------
# (double, double) destination(rlon, rlat, bearing, rdist);
#
# Given a longitude/latitude pair expressed in radians, a bearing in
# radians, and a distance in radians, returns the destination point
# as a longitude/latitude pair in radians.
#------------------------------------------------------------------------
sub destination {

    # get a hold of my parameters
    my ($rlon, $rlat, $bearing, $rdist) = @_;

    # declare local variables
    my ($dlon, $dlat);

    # do the calculation
    $dlat  = &asin(sin($rlat) * cos($rdist) + cos($rlat) * sin($rdist) * cos($bearing));
    $dlon  = $rlon - atan2(sin($bearing) * sin($rdist) * cos($rlat), cos($rdist) - sin($rlat) * sin($dlat));
    $dlon += (2 * $PI) if $dlon < -$PI;
    $dlon -= (2 * $PI) if $dlon > $PI;

    # all done!
    return ($dlon, $dlat);
}


#------------------------------------------------------------------------
# double distance(rlon1, rlat1, rlon2, rlat2);
#
# Given two spherical points specified as longitude/latitude pairs in
# radians, returns the spherical distance between them, also in
# radians.
#------------------------------------------------------------------------
sub distance {

    # get a hold of my parameters
    my ($rlon1, $rlat1, $rlon2, $rlat2) = @_;

    # declare local variables
    my ($term1, $term2);

    # do the calculation
    $term1 = sin(($rlat1 - $rlat2) / 2) ** 2;
    $term2 = cos($rlat1) * cos($rlat2) * (sin(($rlon1 - $rlon2) / 2) ** 2);
    return (2 * &asin(sqrt($term1 + $term2)));
}


#------------------------------------------------------------------------
# (double, double) expand_location(loc);
#
# Expands the location specifier (a string such as "z:221312", "x",
# "l:34.2:-33.22", ...) into a longitude and latitude pair, which is
# then returned.
#------------------------------------------------------------------------
sub expand_location {

    # get a hold of my parameters
    my ($loc) = @_;

    # map each point to lat/lon
    if ($loc =~ /z:(\d+)/) {
	die "Unknown ZIP code: $1\n" unless defined $map_zip{$1};
	return @{$map_zip{$1}};
    } elsif ($loc =~ /l:([^:]+):([^:]+)/) {
	return ($1, $2);
    } elsif ($loc eq 'x') {
	return undef;
    }
}


#------------------------------------------------------------------------
# double ix(x);
#
# Converts the x-value between 0 and 1 to an actual image coordinate.
#------------------------------------------------------------------------
sub ix {

    # get a hold of my parameters
    my ($x) = @_;

    # return the coordinate
    return ($x * $size_x) - $bound{x1};
}


#------------------------------------------------------------------------
# double iy(y);
#
# Converts the y-value between 0 and 1 to an actual image coordinate.
#------------------------------------------------------------------------
sub iy {

    # get a hold of my parameters
    my ($y) = @_;

    # return the coordinate
    return ($y * $size_y) - $bound{y1};
}


#------------------------------------------------------------------------
# double max(a, b);
#
# Returns the maximum of a and b.
#------------------------------------------------------------------------
sub max { return ($_[0] > $_[1]) ? $_[0] : $_[1]; }


#------------------------------------------------------------------------
# double min(a, b);
#
# Returns the minimum of a and b.
#------------------------------------------------------------------------
sub min { return ($_[0] < $_[1]) ? $_[0] : $_[1]; }


#------------------------------------------------------------------------
# (double, double) project(region, lon, lat);
#
# Projects the given map (longitude, latitude) point to a virtual point
# in the unit square, using the clipping parameters given.
#------------------------------------------------------------------------
sub project {

    # get a hold of my parameters
    my ($region, $lon, $lat) = @_;

    # declare local variables
    my ($tx, $ty, $x, $y);

    # perform the projection
    $tx = ($lon - $region->{lon1}) / ($region->{lon2} - $region->{lon1});
    $ty = ($lat - $region->{lat1}) / ($region->{lat2} - $region->{lat1});
    $x  = $region->{x1} + $tx * ($region->{x2} - $region->{x1});
    $y  = $region->{y1} + $ty * ($region->{y2} - $region->{y1});

    # return the projected point
    return ($x, $y);
}


#------------------------------------------------------------------------
# double rad_to_deg(rad);
#
# Converts a value from radians to degrees.
#------------------------------------------------------------------------
sub rad_to_deg {

    # get a hold of my parameters
    my ($rad) = @_;

    # return the value in degrees
    return ($rad * (180.0 / $PI));
}


#------------------------------------------------------------------------
# int set_pen();
#
# Sets the state of the image to reflect the current pen settings and
# returns the color to use for drawing.
#------------------------------------------------------------------------
sub set_pen {

    # set the pen thickness
    $image->setThickness($map_pen{width});

    # set anti-aliased mode if necessary
    if ($map_pen{smooth}) {
	$image->setAntiAliased($map_pen{color}->{object});
	return { object => gdAntiAliased };
    } else {
	return $map_pen{color};
    }
}


#------------------------------------------------------------------------
# double var(name);
#
# Tries to do a substitution on the given name using the current
# variable table.  If the name couldn't be found, we just perform the
# identity operation.
#------------------------------------------------------------------------
sub var {

    # get a hold of my parameters
    my ($name) = @_;

    # return the mapped value, or the original
    return (defined $map_var{$name}) ? $map_var{$name} : $name;
}