#!/usr/bin/perl -w
# -*- perl -*-

#------------------------------------------------------------------------
# Interactive Animated Traffic Analysis (INANNA) software, Version 0.
#
# Written by Mark Meiss (mmeiss@indiana.edu).
# Copyright 1999, 2000 by the Trustees of Indiana University.
# All Rights Reserved.  See LICENSE for details.
#------------------------------------------------------------------------

use strict;

use GD;

# we'll need this later
my $PI = 3.14159265358979323846;

# metric abbreviations for various powers of 10
my %metric = (-12 => 'p', -11 => 'p', -10 => 'p',
 	       -9 => 'n',  -8 => 'n',  -7 => 'n',
	       -6 => 'u',  -5 => 'u',  -4 => 'u',
	       -3 => 'm',  -2 => 'm',  -1 => 'm',
 	        0 => ' ',   1 => ' ',   2 => ' ',
	        3 => 'k',   4 => 'k',   5 => 'k',
	        6 => 'M',   7 => 'M',   8 => 'M',
	        9 => 'G',  10 => 'G',  11 => 'G',
	       12 => 'T',  13 => 'T',  14 => 'T');

# declare global variables
my ($image, $black, $white, $linkname, %links, $link, $load);
my (@errorPercent, $errorMax, $errorMin, @errorLevel, $color);
my ($filename, $timestamp, %config, $errorLevel, @traffic, $percent);
my (%areas, $archive, $labelname, %labels, $label, %palette);
my ($highwater, $foreground, $background, $danger, $boxtype, $boxwidth);
my ($exponent, $digits, @values, $value, $i, $backpage);
my (%cachePercent, %cacheAbsolute);

# report usage information if necessary
if (@ARGV == 0) {
    print << "END";
Usage: template [configuration file]

Consult Mark Meiss (mmeiss\@indiana.edu) for further usage
information, documentation, and what-not.

This is Version 1.22 / Revision Date 1999-04-08.
END
    exit;
}

# read in the configuration file
&readConfig($ARGV[0] || 'template.cfg');

# read in the image
open GIF, $config{template}->[0];
$image = newFromGif GD::Image(*GIF);
close GIF;

# find black and white
$black = &findBlackest($image);
$white = &findWhitest($image);

# create the default background color for the Web page
$backpage = (defined $config{background}) ? $config{background}->[0] : '0xffffff';
$backpage =~ s/0x//o;

# create the array of traffic colors
&createPalette();

# create the default for the overall scale
$config{scale} = [ 'linear', 'relative', '0', '100' ] unless defined $config{scale};
&makeValues();

# draw the lines and percentages
$danger = 0;
foreach $linkname (keys %links) {

    # get the link
    $link = $links{$linkname};

    # set the default parameters
    $link->{history}   = [1]               unless defined $link->{history};
    $link->{style}     = ['full', 'point'] unless defined $link->{style};
    $link->{width}     = $link->{speed}    unless defined $link->{width};
    $link->{errormax}  = [1]               unless defined $link->{errormax};
    $link->{errormin}  = [0.001]           unless defined $link->{errormin};
    $link->{highwater} = [1800]            unless defined $link->{highwater};

    # call the collector script
    ($load, @errorPercent) = split /\n/, `$config{collector}->[0] $linkname $link->{highwater}->[0]`;
    $load = [ split(/\s+/, $load) ];
    @errorPercent = @errorPercent[0 .. $link->{history}->[0]];

    # calculate each error level (errormin = 0, errormax = 1) on a logarithmic scale
    $errorMax = log($link->{errormax}->[0]);
    $errorMin = log($link->{errormin}->[0]);
    @errorLevel = map { if ($_ > 0) {
	                    $errorLevel = (log($_) - $errorMin) / ($errorMax - $errorMin);
                            $errorLevel = 0 if $errorLevel < 0;
 	                    $errorLevel = 1 if $errorLevel > 1;
			} else {
			    $errorLevel = 0;
			}
                        $errorLevel;
		      } @errorPercent;

    # calculate the color
    $value = ($config{scale}->[1] eq 'relative') ? (100 * $load->[0] / $load->[1]) : $load->[0];
    for ($i = 0; $i < $config{colors}->[0]; ++$i) {
	last if ($value >= $values[$i]) && ($value <= $values[$i + 1]);
    }
    $color = ($errorPercent[1] < 0) ? $black : $traffic[$i]->[3];
    if (($load->[0] != -2) && (($errorPercent[1] < 0) || ($errorLevel[1] >= 1))) {
	$danger = ($danger > $link->{highwater}->[0]) ? $danger : $link->{highwater}->[0];
    }

    # draw the line
    &drawArrow($image, @{$link->{arrow}}, $link->{width}->[0], $color, $black, $black, \@errorLevel, @{$link->{style}});

    # cache the values for this link
    $cachePercent{$linkname}  = (($load->[0] / $load->[1]) > 0.995) ? "max" : sprintf("%2d%%", &round(100 * $load->[0] / $load->[1]));
    $cacheAbsolute{$linkname} = &absoluteString($load->[0]);

    # plot the percentage if specified
    if ($load->[0] >= 0 && defined $link->{percent}) {

	# figure out the type of box to draw
	$boxtype = $link->{percent}->[2] || 'relative';

	# figure out the width of the box
	$boxwidth = ($boxtype eq 'absolute') ? 30 : 24;

	# decide on the foreground and background colors depending on alert status
        $foreground = ($errorLevel[0] >= 1) ? $white : $black;
        $background = ($errorLevel[0] >= 1) ? $black : $white;

	# draw the box
	$image->filledRectangle($link->{percent}->[0],                   $link->{percent}->[1],
				$link->{percent}->[0] + ($boxwidth - 1), $link->{percent}->[1] + 13, $foreground);
	$image->filledRectangle($link->{percent}->[0] + 1,               $link->{percent}->[1] + 1,
				$link->{percent}->[0] + ($boxwidth - 2), $link->{percent}->[1] + 12, $background);

	# figure out the percent string to use
	$percent = ($boxtype eq 'relative') ? $cachePercent{$linkname} : $cacheAbsolute{$linkname};

	# draw the percent string
	$image->string(gdSmallFont, $link->{percent}->[0] + 3, $link->{percent}->[1] + 1, $percent, $foreground);
    }

}

# draw the labels
foreach $labelname (keys %labels) {

    # get the label
    $label = $labels{$labelname};

    # draw the spot
    $color = $image->colorExact(@{$label->{color}});
    $color = $image->colorAllocate(@{$label->{color}}) if $color == -1;
    $image->arc($label->{spot}->[0], $label->{spot}->[1],
		$label->{spot}->[2], $label->{spot}->[2], 0, 360, $color);

    # fill it in
    $image->fillToBorder($label->{spot}->[0], $label->{spot}->[1], $color, $color);

    # and draw the border
    $image->arc($label->{spot}->[0], $label->{spot}->[1],
		$label->{spot}->[2], $label->{spot}->[2], 0, 360, $black);

    # draw the text if specified
    if (defined $label->{caption}) {
	$image->string(gdSmallFont, @{$label->{text}}, join(' ', @{$label->{caption}}), $black);
    }
}

# plot the date if asked
if ($config{'time'}) {
    my $localtime = `/bin/date`;
    chomp $localtime;
    $image->string(gdSmallFont, $config{'time'}->[0], $config{'time'}->[1], $localtime, $black);
}

# draw a clock if asked
if ($config{'clock'}) {
    &drawClock($image, (localtime)[2,1], @{$config{'clock'}}[0,1,2], $black);
}

# draw the legend if asked
if ($config{legend}) {
    &drawLegend($image, $black, $white, \@traffic);
}

# write the new image
$filename = $config{prefix}->[0] . '.gif';
open TARGET, "> $filename";
print TARGET $image->gif();
close TARGET;

# and copy it to the archive if asked
if ($config{archive}) {

    # create the directory if necessary
    system "mkdir $config{archive}->[0]" unless -d $config{archive}->[0];

    # copy the gif
    chomp($timestamp = `/bin/date +%Y%m%d-%H%M%S`);
    $archive = $config{archive}->[0] . "/$timestamp.gif";
    system "cp $filename $archive";
}

# write the new Web page
&writeWeb();


#------------------------------------------------------------------------
# string absoluteString(int traffic);
#
# Given the current traffic on a link in bytes per second, returns the
# traffic as a string of four characters.
#
#       1 => '   1'
#      12 => '  12'
#     123 => ' 123'
#    1234 => '1.2k'
#   12345 => ' 12k'
#  123456 => '123k'
# 1234567 => '1.2M'  (etc.)
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub absoluteString {

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

    # declare local variables
    my ($unit, $digits);

    # round off the traffic level
    $traffic = &round($traffic);

    # handle the units case separately
    return sprintf('%4s', $traffic) if $traffic < 1000;

    # otherwise, figure out the unit tag
    $unit = $metric{int(log($traffic) / log(10) + 0.0000000001)};

    # figure out the number of digits in the most significant period
    $digits = length($traffic) % 3;

    # if it's a full period
    if ($digits == 0) {

	# make sure we shouldn't round up
	if (substr($traffic, 0, 4) >= 9995) {
	    return '1.0' . $metric{int(log($traffic) / log(10)) + 1};
	}

	# otherwise, return all three digits
	return sprintf("%3d", &round(substr($traffic, 0, 4) / 10)) . $unit;
    }

    # if it's a one-digit period
    if ($digits == 1) {

	# make sure we shouldn't round up
	if (substr($traffic, 0, 3) >= 995) {
	    return ' 10' . $unit;
	}

	# otherwise, return [first].[second][units]
	return sprintf("%3.1f", substr($traffic, 0, 3) / 100) . $unit;
    }

    # if it's a two-digit period
    if ($digits == 2) {

	# make sure we shouldn't round up
	if (substr($traffic, 0, 3) >= 995) {
	    return '100' . $unit;
	}

	# otherwise, return ' [first][second][unit]'
	return sprintf(" %2d", &round(substr($traffic, 0, 3) / 10)) . $unit;
    }
}


#------------------------------------------------------------------------
# int ceiling(double value);
#
# Returns the smallest integer greater than or equal to value.
# 
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub ceiling {
    return int($_[0] + 0.9999);
}


#------------------------------------------------------------------------
# void createPalette();
#
# Allocates the traffic colors in the image and stores them in the
# global variable @traffic.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub createPalette {

    # declare local variables
    my (%colors, $index, @specified, $i, $from, $to, $fraction, $j);
    my (@backRGB, $transparent);

    # put the defaults in the color hash
    $colors{1} = [0, 255, 0];
    $colors{$config{colors}->[0]} = [255, 0, 0];

    # add the user-specified values
    foreach $index (keys %palette) {
	if ($palette{$index}->[0] =~ /0x([A-F0-9]{2})([A-F0-9]{2})([A-F0-9]{2})/io) {
	    $palette{$index} = [ hex $1, hex $2, hex $3 ];
	}
	$colors{$index} = $palette{$index};
    }

    # get the list of specified indices
    @specified = sort { $a <=> $b } keys %colors;

    # for each specified index
    for ($i = 0; $i < @specified - 1; ++$i) {

	# get the starting index and the ending index
	$from = $specified[$i];
	$to   = $specified[$i + 1];

	# interpolate the colors
	for ($j = &ceiling($from); $j < $to; ++$j) {
	    $fraction = ($j - $from) / ($to - $from);
	    push @traffic, [ $colors{$from}->[0] + $fraction * ($colors{$to}->[0] - $colors{$from}->[0]),
			     $colors{$from}->[1] + $fraction * ($colors{$to}->[1] - $colors{$from}->[1]),
			     $colors{$from}->[2] + $fraction * ($colors{$to}->[2] - $colors{$from}->[2]) ];
	}
    }

    # add the very last color to our list
    push @traffic, $colors{$specified[-1]};

    # allocate the colors
    @traffic = map { [ @{$_}, $image->colorAllocate(@{$_}) ] } @traffic;

    # duplicate the last value in case of 100%
    push @traffic, $traffic[-1];

    # get the hex values for the background color
    $backpage =~ /([A-F0-9]{2})([A-F0-9]{2})([A-F0-9]{2})/io;
    @backRGB = (hex $1, hex $2, hex $3);

    # find the transparent color (if there is one)
    $transparent = $image->transparent();

    # try to set its RGB value to the background
    if ($transparent != -1) {
	$image->colorDeallocate($transparent);
	$image->colorAllocate(@backRGB);
    }
}


#------------------------------------------------------------------------
# void drawArrow(GD::Image image, int x1, int y1, int x2, int y2,
#                int width, int incolor1, int incolor2, int outcolor,
#                listref errorLevel, string thickness, string head);
#
# Draws an arrow from (x1,y1) to (x2,y2) with the given attributes.
#
# width      is the width of the arrow in pixels.
# incolor1   is the foreground color of the arrow.
# incolor2   is the color of the short dashes within the arrow.
# outcolor   is the outline color of the arrow.
# errorLevel is a list of normalized error levels (0 - 1) going BACKWARD in time.
#            index 0 is the "high water mark" for errors.
# thickness  is one of 'full', 'left', or 'right'.
# head       is either 'point' or 'stub'.
#
# A quick guide to the @points array:
#
#                              3 @\
#                                | \
#      1                         |  \
#    @-------------------------2-@   \ @ 4
#    |                                \
#    @ 0                      10 @     @ 5
#    |                                /
#    @-------------------------8-@   / @ 6
#      9                         |  /
#                                | /
#                              7 @/
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub drawArrow {

    # get a hold of my parameters
    my ($image, $x1, $y1, $x2, $y2, $width, $incolor1, $incolor2, $outcolor, $errorLevel, $thickness, $head) = @_;

    # declare local variables
    my ($theta, $wsin, $wcos, $xHead, $yHead, @points, $arrow, $point);
    my ($xBegin1, $yBegin1, $xBegin2, $yBegin2, $xEnd1, $yEnd1, $xEnd2, $yEnd2);
    my (@arrow, $i, @from, @to, $history, $red, $blue, $green, $color, $error);
    my ($xError1, $yError1, $xError2, $yError2, $xError3, $yError3, $xError4, $yError4, $block);

    # find the angle of the arrow and the half-width
    $theta = atan2($y1 - $y2, $x2 - $x1);
    $width /= 2;

    # save some repeated computations
    $wsin = $width * sin($theta);
    $wcos = $width * cos($theta);

    # this is point 10 in the diagram above
    $xHead = $x2 - 2 * $wcos;
    $yHead = $y2 + 2 * $wsin;

    # calculate the critical points for drawing the arrow
    @points = ( [ $x1,                $y1                ],    # 0
		[ $x1    -     $wsin, $y1    -     $wcos ],    # 1
	        [ $xHead -     $wsin, $yHead -     $wcos ],    # 2
		[ $xHead - 2 * $wsin, $yHead - 2 * $wcos ],    # 3
		[ $x2    -     $wsin, $y2    -     $wcos ],    # 4
		[ $x2,                $y2                ],    # 5
		[ $x2    +     $wsin, $y2    +     $wcos ],    # 6
		[ $xHead + 2 * $wsin, $yHead + 2 * $wcos ],    # 7
		[ $xHead +     $wsin, $yHead +     $wcos ],    # 8
		[ $x1    +     $wsin, $y1    +     $wcos ],    # 9
	        [ $xHead,             $yHead             ] );  # 10

    # figure out which points to use
    if ($head eq 'point') {
	   if ($thickness eq 'full')  { @arrow = @points[1, 2, 3, 5, 7, 8, 9]; }
        elsif ($thickness eq 'left')  { @arrow = @points[0, 1, 2, 3, 5]; }
        elsif ($thickness eq 'right') { @arrow = @points[0, 5, 7, 8, 9]; }
    } elsif ($head eq 'stub') {
  	   if ($thickness eq 'full')  { @arrow = @points[1, 2, 3, 4, 6, 7, 8, 9]; }
        elsif ($thickness eq 'left')  { @arrow = @points[0, 1, 2, 3, 4, 5]; }
        elsif ($thickness eq 'right') { @arrow = @points[0, 5, 6, 7, 8, 9]; }
    }

    # create the arrow polygon
    $arrow = new GD::Polygon;
    foreach $point (@arrow) {
	$arrow->addPt(map { &round($_) } @{$point});
    }

    # draw the foreground
    $image->filledPolygon($arrow, $incolor1);

    # find the back end of the arrow
    ($xBegin1, $yBegin1) = @{$points[ ($thickness eq 'right') ?  0 : 1 ]};
    ($xBegin2, $yBegin2) = @{$points[ ($thickness eq 'left')  ?  0 : 9 ]};

    # find the front end of the shaft of the arrow
    ($xEnd1,   $yEnd1)   = @{$points[ ($thickness eq 'right') ? 10 : 2 ]};
    ($xEnd2,   $yEnd2)   = @{$points[ ($thickness eq 'left')  ? 10 : 8 ]};

    # create the list of colors we need
    @from = $image->rgb($incolor1);
    @to   = $image->rgb($incolor2);

    # get the number of history units to keep
    $history = @{$errorLevel} - 1;

    # fade from black to the background color
    for ($i = $history; $i > 0; --$i) {

	# figure out the RGB values
	$red   = &round($to[0] - ($i - 1) * ($to[0] - $from[0]) / $history);
	$blue  = &round($to[1] - ($i - 1) * ($to[1] - $from[1]) / $history);
	$green = &round($to[2] - ($i - 1) * ($to[2] - $from[2]) / $history);

	# use it if we have it
	$color = $image->colorExact($red, $blue, $green);
	$color = $image->colorAllocate($red, $blue, $green) if $color == -1;

	# get the current error level
	$error = $errorLevel->[$i];

	# find the end points for the current error level
	($xError1, $yError1) = ($xBegin1 + $error * ($xEnd1 - $xBegin1), $yBegin1 + $error * ($yEnd1 - $yBegin1));
	($xError2, $yError2) = ($xBegin2 + $error * ($xEnd2 - $xBegin2), $yBegin2 + $error * ($yEnd2 - $yBegin2));

	# draw the error block
	$block = new GD::Polygon;
	$block->addPt(&round($xBegin1), &round($yBegin1));
	$block->addPt(&round($xError1), &round($yError1));
	$block->addPt(&round($xError2), &round($yError2));
	$block->addPt(&round($xBegin2), &round($yBegin2));
	$image->filledPolygon($block, $color);
    }

    # if the high water mark is above zero
    if ($errorLevel->[0] > 0) {

	# calculate the high water points
	($xError1, $yError1) = ($xBegin1 + $errorLevel->[0] * ($xEnd1 - $xBegin1), $yBegin1 + $errorLevel->[0] * ($yEnd1 - $yBegin1));
	($xError2, $yError2) = ($xBegin2 + $errorLevel->[0] * ($xEnd2 - $xBegin2), $yBegin2 + $errorLevel->[0] * ($yEnd2 - $yBegin2));
	($xError3, $yError3) = ($xError2 - 2 * cos($theta), $yError2 + 2 * sin($theta));
	($xError4, $yError4) = ($xError1 - 2 * cos($theta), $yError1 + 2 * sin($theta));

	# draw the high water block
	$block = new GD::Polygon;
	$block->addPt(&round($xError1), &round($yError1));
	$block->addPt(&round($xError2), &round($yError2));
	$block->addPt(&round($xError3), &round($yError3));
	$block->addPt(&round($xError4), &round($yError4));
	$image->filledPolygon($block, $black);
    }

    # draw the outline
    $image->polygon($arrow, $outcolor);
}


#------------------------------------------------------------------------
# int drawClock(GD::Image image, int hour, int minute, int x, int y,
#               int size, int color);
#
# Draws a clock of the given size at the given location with the given
# color, showing -- yup, you guessed it -- the given time.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub drawClock {

    # get a hold of my parameters
    my ($image, $hour, $minute, $x, $y, $size, $color) = @_;

    # declare local variables
    my ($xCenter, $yCenter, $radius, $radiusBegin, $radiusEnd);
    my ($brushSize, $brush, $theta, $sin, $cos, $xPM, $yPM);

    # find the center and radius of the clock
    $xCenter = $x + ($size - 1) / 2;
    $yCenter = $y + ($size - 1) / 2;
    $radius = $size / 2;

    # draw the frame
    $image->arc(&round($xCenter), &round($yCenter), $size, $size, 0, 360, $color);
    $image->arc(&round($xCenter), &round($yCenter), &round($size * 0.90), &round($size * 0.90), 0, 360, $color);

    # find the radii for the hour ticks
    $radiusBegin = $radius * 0.70;
    $radiusEnd   = $radius * 0.85;

    # draw the hour ticks
    for ($theta = 0; $theta < 360; $theta += 30) {

	# get the sine and cosine of the angle
	$sin = sin($theta * $PI / 180);
	$cos = cos($theta * $PI / 180);

	# draw the line
	$image->line(&round($xCenter + $radiusBegin * $cos), &round($yCenter + $radiusBegin * $sin),
		     &round($xCenter + $radiusEnd   * $cos), &round($yCenter + $radiusEnd   * $sin), $color);
    }

    # create a brush for the hands
    $brushSize = &round($size / 20) + 1;
    $brush = new GD::Image($brushSize, $brushSize);
    $brush->filledRectangle(0, 0, $brushSize - 1, $brushSize - 1, $brush->colorAllocate(0, 0, 0));
    $image->setBrush($brush);

    # draw the minute hand
    $theta = $PI * ($minute / 30 - 0.5);
    $image->line(&round($xCenter),                                &round($yCenter),
		 &round($xCenter + 0.80 * $radius * cos($theta)), &round($yCenter + 0.80 * $radius * sin($theta)), gdBrushed);

    # draw the hour hand
    $theta = $PI * (($hour + $minute / 60) / 6 - 0.5);
    $image->line(&round($xCenter),                                &round($yCenter),
		 &round($xCenter + 0.50 * $radius * cos($theta)), &round($yCenter + 0.50 * $radius * sin($theta)), gdBrushed);

    # add a "PM" for pm if requested
    if ($hour >= 12) {
	if ($config{clock}->[3] eq 'up') {
	    $xPM = &round($xCenter - 6);
	    $yPM = &round($y - 13);
	} elsif ($config{clock}->[3] eq 'down') {
	    $xPM = &round($xCenter - 6);
	    $yPM = &round($y + $size);
	} elsif ($config{clock}->[3] eq 'left') {
	    $xPM = &round($x - 14);
	    $yPM = &round($yCenter - 6);
	} elsif ($config{clock}->[3] eq 'right') {
	    $xPM = &round($x + 2);
	    $yPM = &round($yCenter - 6);
	}
	$image->string(gdSmallFont, $xPM, $yPM, 'PM', $color);
    }
}


#------------------------------------------------------------------------
# int drawLegend(GD::Image image, int black, int white, listref scale);
#
# Draws the color legend in a corner of the image.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub drawLegend {

    # get a hold of my parameters
    my ($image, $black, $white, $scale) = @_;

    # declare local variables
    my ($xSize, $ySize, $xStart, $yStart, $i, $title, @labels, $label);
    my ($width, $longest, $exponent, $twodigit);

    # find the image size
    ($xSize, $ySize) = $image->getBounds();

    # create legend labels for linear relative scales
    if (($config{scale}->[0] eq 'linear') && ($config{scale}->[1] eq 'relative')) {
	for ($i = 0; $i < $config{colors}->[0]; ++$i) {
	    push @labels, &round($values[$i]) . '-' . &round($values[$i + 1]) . '%';
	}

    # create legend labels for linear absolute scales
    } elsif (($config{scale}->[0] eq 'linear') && ($config{scale}->[1] eq 'absolute')) {
	for ($i = 0; $i < $config{colors}->[0] - 1; ++$i) {
	    ($label = &absoluteString($values[$i]) . '-' . &absoluteString($values[$i + 1])) =~ s/\s+//go;
	    push @labels, $label;
	}
	($label = &absoluteString($values[-2]) . '+') =~ s/\s+//go;
	push @labels, $label;

    # create legend labels for log and manual relative scales
    } elsif ((($config{scale}->[0] eq 'log') || ($config{scale}->[0] eq 'manual'))
	     && ($config{scale}->[1] eq 'relative')) {

	# for each label
	for ($i = 0; $i < $config{colors}->[0]; ++$i) {

	    # find the exponent of the value
	    $exponent = &floor(log($values[$i + 1]) / log(10));

	    # get the two most significant digits
	    ($twodigit = $values[$i + 1]) =~ s/\.//o;
	    $twodigit =~ s/^0+//o;
	    $twodigit = substr($twodigit, 0, 2) if length($twodigit) > 2;
	    $twodigit =~ s/^(\d)/$1\./o;
	    $twodigit *= 10 ** $exponent;

	    # create the label
	    push @labels, "< $twodigit%";
	}

    # create legend labels for log and manual absolute scales
    } else {
	for ($i = 0; $i < $config{colors}->[0] - 1; ++$i) {
	    ($label = &absoluteString($values[$i + 1])) =~ s/\s+//go;
	    push @labels, "< $label";
	}
	($label = &absoluteString($values[-2])) =~ s/\s+//go;
	push @labels, "> $label";
    }

    # find the length of the longest label
    $longest = 0;
    foreach $label (@labels) {
	$longest = length($label) if $longest < length($label);
    }

    # determine the width of the legend
    $width = ($longest * 6) + 31;

    # determine the starting coordinates
    $xStart = ($config{legend}->[1] eq 'left')  ? 3 : $xSize - ($width + 5);
    $yStart = ($config{legend}->[0] eq 'upper') ? 3 : $ySize - (15 + 12 * defined($config{legendtitle}) + 12 * $config{colors}->[0]);

    # draw the white rectangle and black frame
    $image->filledRectangle($xStart,     $yStart,     $xStart + $width,     $yStart + 11 + 12 * $config{colors}->[0], $black);
    $image->filledRectangle($xStart + 2, $yStart + 2, $xStart + $width - 2, $yStart +  9 + 12 * $config{colors}->[0], $white);

    # draw each entry in the legend
    for ($i = 0; $i < $config{colors}->[0]; ++$i) {
	$image->filledRectangle($xStart + 6, $yStart + 6 + ($i * 12), $xStart + 25, $yStart + 6 + ($i * 12) + 11, $scale->[$i]->[3]);
	$image->string(gdSmallFont, $xStart + 28, $yStart + 6 + ($i * 12), $labels[$i], $black);
    }

    # draw the legend title if necessary
    if (defined $config{legendtitle}) {
	$title = join ' ', @{$config{legendtitle}};
	$xStart = ($config{legend}->[1] eq 'left')  ? 4 : $xSize - (5 + 6 * length($title));
	$image->string(gdSmallFont, $xStart, $yStart + 12 * ($config{colors}->[0] + 1), $title, $black);
    }
}


#------------------------------------------------------------------------
# string escape(string string);
#
# URL-escapes the given string and returns it.  The algorithm is based
# on the one in CGI.pm.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub escape {

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

    # perform the substitution
    $string =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x", ord($1))/eg;

    # and return the new string
    return $string;
}


#------------------------------------------------------------------------
# int findBlackest(GD::Image image);
#
# Returns the index of the blackest color in the given image.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub findBlackest {

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

    # return the index
    return $image->colorClosest(0, 0, 0);
}


#------------------------------------------------------------------------
# int findWhitest(GD::Image image);
#
# Returns the index of the whitest color in the given image.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub findWhitest {

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

    # return the index
    return $image->colorClosest(255, 255, 255);
}


#------------------------------------------------------------------------
# string gmtTimestamp(int epoch);
#
# Returns a GMT timestamp in the standard HTTP format for the given
# Unix epoch time in seconds.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub gmtTimestamp {

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

    # declare local variables
    my ($weekday, $month, $monthday, $year, $hour, $minute, $second);

    # get the pieces we need
    $weekday = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[(gmtime($epoch))[6]];
    $month = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[(gmtime($epoch))[4]];
    ($monthday, $year, $hour, $minute, $second) = (gmtime($epoch))[3,5,2,1,0];

    # return the timestamp
    return sprintf("%s, %02d %s %d %02d:%02d:%02d GMT", $weekday, $monthday, $month, $year+1900, $hour, $minute, $second);
}


#------------------------------------------------------------------------
# int floor(double value);
#
# Returns the greatest integer less than or equal to the given value.
# 
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub floor {

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

    # return the floor integer
    if ($value >= 0) {
	return int($value);
    } else {
	return int($value - 0.999999);
    }
}


#------------------------------------------------------------------------
# void makeValues(void);
#
# Calculates the division values for color classification and the
# legend.  This affects the global variable @values.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub makeValues {

    # declare local variables
    my ($scale, $type, $start, $end, $increment, $i);

    # get the scale, type, start, and end of the scale
    ($scale, $type, $start, $end) = @{$config{scale}};

    # handle the manual case quickly
    if ($scale eq 'manual') {
	unshift @values, 0;
	push @values, ($type eq 'relative') ? 100: 1e99;
	return;
    }	    

    # the starting value is *always* zero
    @values = (0);

    # if it's a linear scale
    if ($scale eq 'linear') {

	# calculate the increment
	$increment = ($end - $start) / ($config{colors}->[0] - 2);

	# create the list of values
	for ($i = 0; $i < $config{colors}->[0] - 1; ++$i) {
	    push @values, $start + ($increment * $i);
	}

	# add on the last value depending on the type
	push @values, ($type eq 'relative') ? 100 : 1e99;

    # if it's a log scale
    } else {

	# calculate the increment
	$increment = ($end - $start) / ($config{colors}->[0] - 2);

	# create the list of values
	for ($i = 0; $i < $config{colors}->[0] - 1; ++$i) {
	    push @values, 10 ** ($start + ($increment * $i));
	}

	# add on the last value depending on the type
	push @values, ($type eq 'relative') ? 100 : 1e99;
    }
}


#------------------------------------------------------------------------
# void readConfig(string filename);
#
# Reads in the configuration file with the given filename.  The global
# variables @values, %areas, %config, %labels, %links, and %palette
# are modified.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub readConfig {

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

    # declare local variables
    my (@pieces);

    # open the configuration file
    open CONFIG, $filename;

    # while there's data left
    while (<CONFIG>) {

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

	# get the list of words
	@pieces = split /\s+/, $_;

	# store the line based on its type
	if ($pieces[0] eq 'area') {
	    $areas{$pieces[1]}->{$pieces[2]} = [ @pieces[3..$#pieces] ];
	} elsif ($pieces[0] eq 'link') {
	    $links{$pieces[1]}->{$pieces[2]} = [ @pieces[3..$#pieces] ];
	} elsif ($pieces[0] eq 'param') {
	    $config{$pieces[1]} = [ @pieces[2..$#pieces] ];
	} elsif ($pieces[0] eq 'label') {
	    $labels{$pieces[1]}->{$pieces[2]} = [ @pieces[3..$#pieces] ];
	} elsif ($pieces[0] eq 'palette') {
	    $palette{$pieces[1]} = [ @pieces[2..4] ];
	} elsif ($pieces[0] eq 'scale') {
	    push @values, $pieces[1];
	}
    }

    # sort the list of values
    @values = sort { $a <=> $b } @values;

    # we're done
    close CONFIG;
}


#------------------------------------------------------------------------
# int round(double value);
#
# Rounds the given value to the nearest integer.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub round {

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

    # return the rounded value
    return ($value > 0) ? int($value + 0.5) : int($value - 0.5);
}


#------------------------------------------------------------------------
# void writeWeb();
#
# Writes out the new Web page with the image map, with an alert
# if any link is down or has maximal errors.
#
# Copyright 2000, the Trustees of Indiana University
#------------------------------------------------------------------------
sub writeWeb {

    # declare local variables
    my ($filename, $title, $coords, $text, $short, $timestamp, $area);
    my ($archiveParam, $titleParam, $linkParam, $alert);
    my ($base, @add, $link, $i, $tag); 

    # open the file
    $filename = $config{prefix}->[0] . '.html';
    open TARGET, "> $filename";

    # calculate the title
    $title = join ' ', @{$config{title}};

    # calculate the short prefix
    $short = (split /\//, $config{prefix}->[0])[-1];

    # calculate the archive, title, and link parameters
    $archiveParam = &escape($config{archive}->[0]);
    $titleParam   = &escape($title);
    $linkParam    = &escape("$short.html");

    # calculate the expiration date
    $timestamp = &gmtTimestamp(time + $config{refresh}->[0]);

    # calculate the sound string
    $alert = $danger ? '<center><font size="+2"><strong>ALERT</strong></font>: One or more links has experienced problems in the last ' . int($danger / 60) . ' minutes.<br><br> </center>' : '';

    # print the header
    print TARGET << "END";
<html>
  <head>
    <meta http-equiv="Refresh" content="$config{refresh}->[0];URL=$short.html">
    <meta http-equiv="Expires" content="Thu, 26 Feb 1976 12:00:00 GMT">
    <meta http-equiv="Pragma" content="no-cache">
    <title>$title</title>
  </head>
  <body bgcolor="#$backpage">
    $alert
    <img src="$short.cgi" usemap="#areas" border="0">
    <map name="areas">
END

    # print the image map areas
    foreach $area (values %areas) {

	# get the list of coordinates
	$coords = join ',', @{$area->{polygon}};

	# if there's a text message, construct the message
	if (defined $area->{text}) {
	    $base = join(' ', @{$area->{text}});
	    if (defined $area->{traffic}) {
		@add = ();
		for ($i = 0; $i < @{$area->{traffic}}; $i += 2) {
		    ($link, $tag) = @{$area->{traffic}}[$i, $i+1];
		    $cachePercent{$link}  =~ s/^\s+//o;
		    $cacheAbsolute{$link} =~ s/^\s+//o;
		    $tag =~ s/_/ /go;
		    push @add, "$cacheAbsolute{$link} $tag ($cachePercent{$link})";
		}
		$base .= "; \n" . join("; \n", @add);
	    }
	}

	# add the alt and title attribute if appropriate
	$text  =       (defined $area->{text}) ? "alt='$base'"   : '';
	$text .= ' ' . (defined $area->{text}) ? "title='$base'" : '';

	# add this area to the imagemap
	print TARGET "<area href='$area->{url}->[0]' $text shape='poly' coords='$coords'>\n";
    }

    # finish up the page
    print TARGET << "END";
    </map>
    <center>
      <table border="0" cellpadding="6">
        <tr>
          <th bgcolor="#ffa0a0"> <a href="movie.cgi?archive=$archiveParam&title=$titleParam&link=$linkParam">Movies</a>
          <th bgcolor="#80ffff"> <a href="http://hydra.uits.iu.edu/~traffic/documentation">Documentation</1a>
        </tr>
      </table>
    </center>
  </body>
</html>
END
    close TARGET;

    # and write the image-serving CGI
    $filename = $config{prefix}->[0] . '.cgi';
    open TARGET, "> $filename";
    print TARGET << "END";
#!/usr/bin/perl -w
# -*- perl -*-

print "Content-type: image/gif\\n";
print "Expires: Thu, 26 Feb 1976 12:00:00 GMT\\n";
print "Pragma: no-cache\\n\\n";
print `/bin/cat $short.gif`;
exit;
END
    close TARGET;

    # make it executable
    system "/bin/chmod +x $filename";

    # we're done
    return;
}


#------------------------------------------------------------------------
# $Log$
