#!/usr/local/bin/perl

# The maximum image height seems to be ~32768. I don't know if that's a browser limit or a GD limit.
# Ticks may not work right for split scale.

# Feature ideas:
#   thresholded color mappings (ignore values above/below a treshold so they don't affect coloring)
#   alpha correction
#   produce multiple formats in one invocation

use strict;

use GD;

use lib "/Genomics/CQB/$ENV{'DEVUSER'}/lib";
use picoXML;


my $DEBUG = 0;


sub errmsg {
    my $msg = shift;

    return "** ",uc($msg)," **\n";
}


sub usage_exit {
    my $msg = shift;

    if ($msg) {
	print STDERR "\n",&errmsg($msg),"\n";
    }

    print STDERR "\
Usage syntax:\
  [options] source [[options] source]...\
Usage options (defaults in []'s):\
  --output-base=?  The first part of the output file names. [derived from source file]\
  --gamma=?        Gamma correction for coloring. [1]\
  --log            Logarithmic (magnitude) plot. [no]\
  --center=?       Center colors on this value. [mean]\
  --split-scale    Use different scales above and below the center\
                   (for better color resolution). [off]\
  --no-labels      Ignore labels in source file. [off]\
  --low-color=?    Set the low end color. [green]\
  --center-color=? Set the center color. [black]\
  --high-color=?   Set the high end color. [red]\
  --nan-color=?    Set the color for undefined values. [darkgrey]\
  --el-width=?     Width of map element (pixels). [8]\
  --el-height=?    Height of map element (pixels). [8]\
By default the output file name will be derived from the\
name of the source file. These are equivalent:\
  heatmap_table.pl data.pxml\
  heatmap_table.pl --output-base=data data.pxml\
Color specification may be:\
  by name (red, green, blue, black, darkgrey, grey, white, yellow)\
  by RGB values:\
    255:0:0 (red), 0:255:0 (green), 127:127:127 (grey), etc.\
Color examples:\
  Green to black center then to blue:\
    --low-color=green --center-color=black --high-color=0:0:255\
  A graded blue band (black to blue):\
    --low-color=black --center-color=0:0:127 --high-color=0:0:255\
  A band graded from yellow to blue:\
    --low-color=yellow --center-color=grey --high-color=blue\
Note: Any options apply only to source file(s) that follow.\
For example, this will color the first map green-yellow and\
the second map blue-yellow:\
  --high-color=yellow data1.pxml --low-color=blue data2.pxml\
These examples are NOT equivalent:\
  heatmap_table.pl data.pxml --output-base=map\
  heatmap_table.pl --output-base=map data.pxml\
\n";
#  --no-divs        Ignore dividers in source file. [off]\
#  --bar-placement  (h|v)(b|r) Horizontal or vertical, below map\
#                   or to right of map. [vb]\

    exit(1);
}


# Large images are split into tables. These define the max number
# pixels in height and width of a cell.
my $MAX_CELL_WIDTH = 8192;
my $MAX_CELL_HEIGHT = 8192;

# actual cell dimentions (pixels)
my ($cell_width, $cell_height);
my $image_padding = 5;
my ($num_table_rows, $num_table_cols);

#my $el_width = 8;         # default
#my $el_height = 8;        # default
my $max_col_label_margin = 300;
my $max_row_label_margin = 300;

my $col_label_margin;
my $row_label_margin;

my $key_step = 1;          # may be modified later
my $key_el_width = 50;     # actually computed later on
my $key_el_height = 1;     # draw rectangles instead of lines if > 1
my $key_tick_length = 10;
my $key_width;
my $key_length;

my $char_width = 5;        #! should be determined from font
my $char_height = 7;       #! should be determined from font

my $min_el_width = $char_height + 1;
my $min_el_height = $char_height + 1;

my $max_val;
my $min_val;
my $mean_val = 0;
my $mid_val;
my $center;
my $nvals = 0;

my $last_time = time;

#my $MAX_DEBUG_ROWS = 4000;

# colors will be set from settings, which have defaults
my @low_rgb = ( 0, 0, 0 );
my @center_rgb = ( 0, 0, 0 );
my @high_rgb = ( 0, 0, 0 );

my ($nan_color, $fg_color);    #! globals
my ($ncols, $nrows);   #! globals
my ($low_key_scale, $high_key_scale);  #! globals
my $filename;   #! global

my %settings = (
		"output-base" => undef,
		"gamma" => 1.0,
		"el-width" => 8,
		"el-height" => 8,
		"log" => 0,
		"center" => undef,
		"split-scale" => 0,
		"no-divs" => 0,
		"no-labels" => 0,
		"png" => 0,
		"svg" => 0,   #! not implemented, just a placeholder now
		"low-color" => "green",
		"center-color" => "black",
		"high-color" => "red",
		"nan-color" => "darkgrey",
		"bar-placement" => "",
		);

select STDERR; $| = 1; select STDOUT; $| = 1;

my $bar_orientation = "v";
my $bar_placement = "b";

#&xml_settings;    #! should be able to get some settings from XML (like colors)
&parse_args;

$DEBUG && print STDERR "time to exit: ",time - $last_time,"\n";   $last_time = time;

exit(0);


sub load_xml {
    my $filename = shift;
    my $xml = new picoXML::block;
#! set path
    $xml->load(path => $filename, tag => "heatmap");
    return $xml;
}


sub load_flat {
    my $filename = shift;
    my $xml;

    if (open(IN, $filename)) {
	$xml = new picoXML::block;
	while (<IN>) {
	    my $line = $_;
	    chomp($line);

	    my $row = $xml->new_block(class => 'row');

	    my @fields = split(/\t/, $line);
	    for (my $f = 0; $f <= $#fields; $f++) {
		my $v = $row->new_block(class => 'v', value => $fields[$f]);
	    }
	}
	close(IN);
    }
    return $xml;
}


sub lit_rgb {
    my $rgbref = shift;
    @$rgbref = ( shift, shift, shift );
    for (my $i = 0; $i < 3; $i++) {
	$rgbref->[$i] = 255 if ($rgbref->[$i] > 255);
#	    $rgbref->[$i] = 0 if ($rgbref->[$i] < 0);   # not possible
    }
}


sub set_rgb {
    my $rgbref = shift;
    my $name = shift;

    ($name eq "red")? @$rgbref = ( 255, 0, 0 )
    : ($name eq "green")? @$rgbref = ( 0, 255, 0 )
    : ($name eq "blue")? @$rgbref = ( 0, 0, 255 )
    : ($name eq "black")? @$rgbref = ( 0, 0, 0 )
    : ($name eq "darkgrey")? @$rgbref = ( 80, 80, 80 )
    : ($name eq "grey")? @$rgbref = ( 127, 127, 127 )
    : ($name eq "white")? @$rgbref = ( 255, 255, 255 )
    : ($name eq "yellow")? @$rgbref = ( 255, 255, 0 )
#    : ($name eq "purple")? @$rgbref = ( 255, 0, 255 )
    : ($name =~ /^(\d+)\:(\d+)\:(\d+)$/)? &lit_rgb($rgbref, $1, $2, $3)
    : die &errmsg("bad color specification or unknown color '$name'");
#    print "rgb color '$name' is ",@$rgbref,"\n";
}


sub draw_map {
    my $xml = shift;

    ### First get some statistics

    my @cols = $xml->blocks_by_class("col");
    my $max_col_label_len = 0;
    unless ($settings{'no-labels'}) {
	# scan for column label lengths
	for (my $c = 0; $c <= $#cols; $c++) {
	    my $label = $cols[$c]->firstval("label");
	    my $len;
	    if (!defined($label)) {
		$len = length("# $c");
	    } else {
		$len = length($label);
	    }
	    if (!defined($max_col_label_len)) {
		$max_col_label_len = $len;
	    } elsif ($len > $max_col_label_len) {
		$max_col_label_len = $len;
	    }
	}
    }

    # process rows and values
    my @rows = $xml->blocks_by_class("row");
    $nrows = 0;
    $ncols = 0;
    my $max_row_label_len = 0;
    my $misc_y_pixels = 0;
    for (my $r = 0; $r <= $#rows; $r++) {
#	last if ($r >= $MAX_DEBUG_ROWS);
	my @vals = $rows[$r]->blocks_by_class("v");
	$nrows++;
	$ncols = $#vals + 1 if ($#vals + 1 > $ncols);
	for (my $v = 0; $v <= $#vals; $v++) {
	    my $val = $vals[$v]->{'value'};
	    if ($val !~ /NaN/i) {
		if ($settings{'log'}) {
		    if ($val == 0) {
			die &errmsg("can't take log of 0");
		    }
		    $val = log(abs($val));
		}
#	        $val /= 10000;   #!!! TEST
#	        $val -= 100000;   #!!! TEST
		if (!defined($max_val)) {
		    $min_val = $max_val = $val;
		} else {
		    if ($val < $min_val) {
			$min_val = $val;
		    }
		    if ($val > $max_val) {
			$max_val = $val;
		    }
		}
		$mean_val += $val;
		$nvals++;
	    }
	    unless ($settings{'no-labels'}) {
		if (!defined($cols[$v])) {
		    $cols[$v] = new picoXML::block;
		}
		if (!defined($cols[$v]->firstval("label"))) {
		    $cols[$v]->firstval("label", "# $v");
		    my $len = length("# $v");
		    if (!defined($max_col_label_len)) {
			$max_col_label_len = $len;
		    } elsif ($len > $max_col_label_len) {
			$max_col_label_len = $len;
		    }
		}
	    }
	}
	unless ($settings{'no-labels'}) {
	    my $row_label = $rows[$r]->firstval("label");
	    my $len;
	    if (!defined($row_label)) {
		$len = length("# $r");
	    } else {
		$len = length($row_label);
	    }
	    if (!defined($max_row_label_len)) {
		$max_row_label_len = $len;
	    } elsif ($len > $max_row_label_len) {
		$max_row_label_len = $len;
	    }
	}
	if ((!$settings{'no-divs'}) && (defined($rows[$r]->firstval("div")))) {
	    $misc_y_pixels++;
	}
    }
    if ($nvals == 0) {
	die &errmsg("no values found in map");
    }
    $mean_val /= $nvals;
    $mid_val = ($max_val + $min_val) / 2.0;

    if ($DEBUG) {
	print STDERR "$nrows rows, $ncols cols\n";
	print STDERR "min_val $min_val\n";
	print STDERR "mean_val $mean_val\n";
	print STDERR "mid_val $mid_val\n";
	print STDERR "max_val $max_val\n";
	print STDERR "max_row_label_len $max_row_label_len\n";
	print STDERR "max_col_label_len $max_col_label_len\n";
    }

    if ($min_val >= $max_val) {
	die &errmsg("minumum data value must be less than maximum value");
    }

    $settings{'no-col-labels'} = $settings{'no-row-labels'} = $settings{'no-labels'};
    if (($max_col_label_len > 0) && ($settings{'el-width'} < $min_el_width)) {
	print STDERR &errmsg("el-width too small to include column labels - increase el-width to $char_width or use --no-labels");
	$settings{'no-col-labels'} = 1;
    }
    if (($max_row_label_len > 0) && ($settings{'el-height'} < $min_el_height)) {
	print STDERR &errmsg("el-height too small to include row labels - increase el-height to $char_height or use --no-labels");
	$settings{'no-row-labels'} = 1;
    }

    $center = $settings{'center'};
    if (!defined($center)) {
	$center = $mean_val;
    } else {
	($center eq "mean")? $center = $mean_val
	    : ($center eq "min")? $center = $min_val
	    : ($center eq "max")? $center = $max_val
	    : ($center eq "mid")? $center = $mid_val
	    : eval { };  #! test if all digits
    }
    if (($center < $min_val) || ($center > $max_val)) {
	die &errmsg("center value must be between minumum ($min_val) and maximum ($max_val) values (inclusive)");
    }

    ### Figure out the image geometries and colors.

#    my $key_length = $key_el_height + $key_tick_height + $char_height;
    $key_length = $key_el_height * 256;

    my $map_width = $settings{'el-width'} * $ncols;
    my $map_height = $settings{'el-height'} * $nrows + $misc_y_pixels;
#    print STDERR "map height $map_height width $map_width\n";

    $DEBUG && print STDERR "time to image: ",time - $last_time,"\n";   $last_time = time;

    my $scale = 1.0;

    $col_label_margin = $settings{'no-col-labels'}? 0
	: $max_col_label_len * $char_width + $image_padding;
    if ($col_label_margin > $max_col_label_margin) {
	$col_label_margin = $max_col_label_margin;
    }
    $row_label_margin = $settings{'no-row-labels'}? 0
	: $max_row_label_len * $char_width + $image_padding;
    if ($row_label_margin > $max_row_label_margin) {
	$row_label_margin = $max_row_label_margin;
    }

    $key_width = $key_el_width + $key_tick_length + $char_width * 16 ;  #! should depend on actual key tick label lengths

    my ($img_height, $img_width);
    $img_height = $map_height + $col_label_margin;
    $img_width = $map_width + $row_label_margin;
    if (!$settings{'bar-placement'}) {
	if ($img_height > $img_width) {
	    $bar_orientation = "v";
	    $bar_placement = "r";
	}
    }
    if ($bar_orientation eq "h") {
	if ($bar_placement eq "r") {
	    $img_width += $key_length;
	    if ($img_height < $key_width) {
		$img_height = $key_width;
	    }
	} else {
	    $img_height += $key_width;
	    if ($img_width < $key_length) {
		$img_width = $key_length;
	    }
	}
    } else {
	if ($bar_placement eq "r") {
	    $img_width += $key_width;
	    if ($img_height < $key_length) {
		$img_height = $key_length;
	    }
	} else {
	    $img_height += $key_length;
	    if ($img_width < $key_width) {
		$img_width = $key_width;
	    }
	}
    }

    $DEBUG && print STDERR "img height $img_height width $img_width\n";

    # allow for different scaling of high and low values, but default to same
    $low_key_scale = abs($min_val-$center);
    $high_key_scale = abs($max_val-$center);
    # the default is to just take use the max of both
    if (!$settings{'split-scale'}) {
	if ($low_key_scale > $high_key_scale) {
	    $high_key_scale = $low_key_scale;
	} else {
	    $low_key_scale = $high_key_scale;
	}
    }
#    print "low key scale $low_key_scale high_key_scale $high_key_scale\n";

    # figure out how to split the image
    # if we can do it in one image, then do so
    $num_table_cols = 1;
    if ($img_width >= 2**15) {
	for ($num_table_cols = 1; $ncols * $settings{'el-width'} / $num_table_cols > $MAX_CELL_WIDTH; $num_table_cols++) {};
    }
    # make cell width a multiple of el-width
    $cell_width = int($ncols / $num_table_cols) * $settings{'el-width'};
    $num_table_rows = 1;
    if ($img_height >= 2**15) {
	for ($num_table_rows = 1; $nrows * $settings{'el-height'} / $num_table_rows > $MAX_CELL_HEIGHT; $num_table_rows++) {};
    }
    # make cell height a multiple of el-height
    $cell_height = int($nrows / $num_table_rows) * $settings{'el-height'};

    $DEBUG && print STDERR "cell width $cell_width, height $cell_height\n";

#    unless ($settings{'no-labels'}) {
#	&draw_col_labels(\@cols, 0, $#cols);
#	&draw_row_labels(\@rows, 0, $#rows);
#    }
    &draw_col_labels(\@cols, 0, $#cols) unless ($settings{'no-col-labels'});
    &draw_row_labels(\@rows, 0, $#rows) unless ($settings{'no-row-labels'});

    $DEBUG && print STDERR "time to draw: ",time - $last_time,"\n";   $last_time = time;

    ### Draw the images

    my ($image, $colors);
    my ($row_n, $col_n) = (0, 0);
    for (my $r = 0; $r <= $#rows; $r++) {
#	last if ($r >= $MAX_DEBUG_ROWS);
	my @vals = $rows[$r]->blocks_by_class("v");
	my $y = $r * $settings{'el-height'};
	#! don't know how to do divs with cells
#	if ((!$settings{'no-divs'}) && (defined($rows[$r]->firstval("div")))) {
#	    $image->line(0, $y, $ncols * $settings{'el-width'}, $y, $div_color);
#	    $y++;
#	}
	if (!defined($image)) {
	    ($image, $colors) = &new_image($cell_width, $cell_height);
	} elsif ($y >= ($row_n+1) * $cell_height) {
	    &write_image($image, $row_n."_".$col_n);
	    ($image, $colors) = &new_image($cell_width, $cell_height);
	    $row_n++;
	}
	$y -= $row_n * $cell_height;
	for (my $v = 0; $v <= $#vals; $v++) {
	    my $val = $vals[$v]->{'value'};
	    my $color;
	    if ($val =~ /NaN/i) {
		$color = $nan_color;
	    } else {
		my $color_idx;
		if ($settings{'log'}) {
		    $val = log(abs($val));
		}
#	    $val /= 10000;   #!!! TEST
#	    $val -= 100000;   #!!! TEST
		if ($val == $center) {
		    $color_idx = 128;
		} elsif ($val < $center) {
#	        $color_idx = 127 - 127 * ($center - $val) / ($center - $min_val);
		    $color_idx = 127 - int(127.0 * ($center - $val) / $low_key_scale);
		} else {
#    	        $color_idx = 127 * ($val - $center) / ($max_val - $center) + 128;
		    $color_idx = 128 + int(127.0 * ($val - $center) / $high_key_scale);
		}
		$color = $colors->[$color_idx];
	    }
	    my $x = $v * $settings{'el-width'};
	    if ($x >= ($col_n+1) * $cell_width) {
		&write_image($image, $row_n."_".$col_n);
		($image, $colors) = &new_image($cell_width, $cell_height);
		$col_n++;
	    }
	    $x -= $col_n * $cell_width;
	    $image->filledRectangle($x, $y, $x + $settings{'el-width'}, $y + $settings{'el-height'}, $color);
	}
    }
    &write_image($image, $row_n."_".$col_n);

    $num_table_cols = $col_n + 1;
    $num_table_rows = $row_n + 1;

    ## And finally draw the rainbow key

    &draw_key;

    &print_table;
}


sub new_image {
    my ($img_width, $img_height) = @_;

    my $image = new GD::Image($img_width, $img_height);

    # background color is first allocated
    my $bg_color = $image->colorAllocate(255,255,255);
    # foreground color is second allocated
    $fg_color = $image->colorAllocate(0,0,0);
    # color for dividers in map
    my $div_color = $bg_color;

    # color for undefined values
    my @nan_rgb;
    &set_rgb(\@nan_rgb, $settings{'nan-color'});
    $nan_color = $image->colorAllocate(@nan_rgb);  #! global

    # figure out the rgb values from the colors in settings
    &set_rgb(\@low_rgb, $settings{'low-color'});
    &set_rgb(\@center_rgb, $settings{'center-color'});
    &set_rgb(\@high_rgb, $settings{'high-color'});

    # allocate colors - scale from low_rgb to center_rgb and center_rgb to high_rgb
    my $ncolors = 256;   # need to change constants below (127) if this is changed
    my $colors;
    for (my $c = 0; $c < $ncolors; $c++) {
	# ok, technically we don't need to check if gamma is 1, but hey it's a little cleaner
	my @rgb;
	my $gamma = $settings{'gamma'};
	my $end_scale;
	if ($c < 128) {
	    $end_scale = 2*((127-$c)**$gamma)/(127**($gamma-1.0)) / 256.0;
	    for (my $i = 0; $i < 3; $i++) {
		$rgb[$i] = $end_scale * $low_rgb[$i] + (1.0 - $end_scale) * $center_rgb[$i];
	    }
	} else {
	    $end_scale = 2*(($c-128)**$gamma)/(127**($gamma-1.0)) / 256.0;
	    for (my $i = 0; $i < 3; $i++) {
		$rgb[$i] = $end_scale * $high_rgb[$i] + (1.0 - $end_scale) * $center_rgb[$i];
	    }
	}
	$colors->[$c] = $image->colorAllocate($rgb[0], $rgb[1], $rgb[2]);
#    if ($gamma != 1.0) {
#	    $colors->[$c] = $image->colorAllocate(0, 2*((127-$c)**$gamma)/(127**($gamma-1.0)), 0);
#	} else {
#	    $colors->[$c] = $image->colorAllocate(0, (127-$c)*2, 0);
#	}
#    } else {
#	if ($gamma != 1.0) {
#	    $colors->[$c] = $image->colorAllocate(2*(($c-128)**$gamma)/(127**($gamma-1.0)), 0, 0);
#	} else {
#	    $colors->[$c] = $image->colorAllocate(($c-128)*2, 0, 0);
#	}
#    }
    }

    return $image, $colors;
}


sub draw_col_labels {
    my ($cols, $start_col, $end_col) = @_;

    my $n = 0;
    my ($image, $colors);
    for (my $c = $start_col; $c <= $end_col; $c++) {
	my $x = ($c - $start_col) * $settings{'el-width'};
	my $y = $col_label_margin - $image_padding;
	if (!defined($image)) {
	    ($image, $colors) = &new_image($cell_width, $col_label_margin);
	} elsif ($x >= ($n+1) * $cell_width) {
	    &write_image($image, "col_label_$n");
	    ($image, $colors) = &new_image($cell_width, $col_label_margin);
	    $n++;
	}
	$x -= $n * $cell_width;
	my $label = $cols->[$c]->firstval("label");
	if (!defined($label)) {
	    $label = "# $c";
	}
	$image->stringUp(gdTinyFont, $x, $y,
			 &trunc_label($label, $col_label_margin),
			 $fg_color);
    }
    &write_image($image, "col_label_$n");
}


sub draw_row_labels {
    my ($rows, $start_row, $end_row) = @_;

    my $n = 0;
    my ($image, $colors);
    for (my $r = $start_row; $r <= $end_row; $r++) {
	my $x = $image_padding;
	my $y = $r * $settings{'el-height'};
	if (!defined($image)) {
	    ($image, $colors) = &new_image($row_label_margin, $cell_height);
	} elsif ($y >= ($n+1) * $cell_height) {
	    &write_image($image, "row_label_$n");
	    ($image, $colors) = &new_image($row_label_margin, $cell_height);
	    $n++;
	}
	$y -= $n * $cell_height;
	my $label = $rows->[$r]->firstval("label");
	if (!defined($label)) {
	    $label = "# $r";
	}
	$image->string(gdTinyFont, $x, $y,
		       &trunc_label($label, $row_label_margin),
		       $fg_color);
    }
    &write_image($image, "row_label_$n");
}


sub draw_key {
    my ($image, $colors) = &new_image($key_width, $key_length);

    my ($x0, $y0) = ($image_padding, 0);
    my $log10 = log(10);

#    my $tick_exp = 10**(int(log($max_tick_val-$min_tick_val)/$log10) - 1);
    my $tick_exp = 10**(int(log($max_val-$min_val)/$log10) - 1);
    my $tick_step = $tick_exp;
    my $ratio = abs($max_val-$center)/abs($min_val-$center);
    $DEBUG && print STDERR "ratio $ratio\n";

    my $min_tick_val;
    my $max_tick_val;
    if ($ratio > 1) {
	$max_tick_val = int($max_val/$tick_exp) * $tick_exp;
	$min_tick_val = int(($center-($center-$min_val)*$ratio)/$tick_exp) * $tick_exp;
    } else {
	$min_tick_val = int($min_val/$tick_exp) * $tick_exp;
	$max_tick_val = int(($center+($max_val-$center)/$ratio)/$tick_exp) * $tick_exp;
    }
    my $next_tick_val = $min_tick_val;
    while (($max_tick_val-$min_tick_val) / $tick_step > 25) {
	$tick_step *= 2;
    }
    if ($DEBUG) {
	print STDERR "min tick $min_tick_val max tick $max_tick_val tick step $tick_step tick_exp $tick_exp\n";
	print STDERR "should be ",($max_tick_val - $min_tick_val) / $tick_step, " ticks\n";
    }

    for (my $c = 0; $c <= $#$colors; $c += $key_step) {
	my ($x, $y);
	if ($bar_orientation eq "h") {
	    ($x, $y) = ($x0 + $c * $key_el_height, $y0);
	    $image->line($x, $y, $x, $y + $key_el_width, $colors->[$c]);
	} else {
	    ($x, $y) = ($x0, $y0 + $c * $key_el_height);
	    $image->line($x, $y, $x + $key_el_width, $y, $colors->[$c]);
	}
	my $tick = 0;
	if ($next_tick_val < $center) {
	    if ($c >= 127 - int(127.0 * ($center - $next_tick_val) / $low_key_scale)) {
		$tick = 1;
	    }
	} else {
	    if ($c >= 128 + int(127.0 * ($next_tick_val - $center) / $high_key_scale)) {
		$tick = 1;
	    }
	}
	if ($tick) {
	    my $offset = int($char_height / 2 + 0.5);
	    my ($x1, $y1);
	    if ($bar_orientation eq "h") {
		($x1, $y1) = ($x - $offset, $y + $key_el_width);
		$image->line($x, $y1, $x, $y1 + $key_tick_length, $fg_color);
		# one character width of padding
		$image->string(gdTinyFont, $x1, $y1 + $key_tick_length + $char_width, $next_tick_val, $fg_color);
	    } else {
		($x1, $y1) = ($x + $key_el_width, $y - $offset);
		$image->line($x1, $y, $x1 + $key_tick_length, $y, $fg_color);
		# one character width of padding
		$image->string(gdTinyFont, $x1 + $key_tick_length + $char_width, $y1, $next_tick_val, $fg_color);
	    }
	    $next_tick_val = $next_tick_val + $tick_step;
	    if ($next_tick_val < 0) {
		$next_tick_val = int($next_tick_val/$tick_exp - 0.01) * $tick_exp;    # round
	    } else {
		$next_tick_val = int($next_tick_val/$tick_exp + 0.01) * $tick_exp;    # round
	    }
	    $DEBUG && print STDERR "next tick $next_tick_val\n";
	}
    }

    &write_image($image, "key");
}


sub write_image {
    my $image = shift;
    my $name = shift;

    my $outfilename;
    if (defined($settings{'output-base'})) {
	$outfilename = $settings{'output-base'};
    } else {
	$outfilename = $filename;
	$outfilename =~ s/\.[^\..]+$//;   #! ok to just remove any extension?
    }
    $outfilename .= "_".$name.".png";

    $DEBUG && print STDERR "time to write $name: ",time - $last_time,"\n";   $last_time = time;
    
    if (!open(_OUT_, ">".$outfilename)) {
	die &errmsg("cannot create output file: $!");
    }

    binmode _OUT_;
    print _OUT_ $image->png;
    close(_OUT_);
}


sub process_file {
    $filename = shift;

    my $xml;
    if ($filename =~ /\.pxml$/) {
	$xml = &load_xml($filename);
    } else {
	# We convert internally to picoXML. This may seem backwards,
	# but it actually simplifies things...
	$xml = &load_flat($filename);
    }
    if (!defined($xml)) {
	die &errmsg("cannot open input file '$filename': $!");
    }
    &draw_map($xml);

#    delete($image);
#    delete($xml);
}


sub parse_args {
    my $argn;

    for ($argn = 0; $argn <= $#ARGV; $argn++) {
	my $arg = $ARGV[$argn];

	if (($arg =~ /^\-+h$/) || ($arg =~ /^\-+help$/)) {
	    # help
	    &usage_exit;
	}

	if ($arg !~ /^\-\-/) {
	    &process_file($arg);  #! check for error
	    next;
	}

	if ($argn == $#ARGV) {
	    &usage_exit("last argument should not be an option");
	}

	$arg =~ s/^\-\-//;

	my ($var, $val) = split(/=/, $arg);
	if (!defined($var)) {
	    &usage_exit("can't grok '$arg'");
        }
	$var =~ s/\_/\-/g;  # ignore common error
	$val = -1 if (!defined($val));   # -1 denotes default value, ok for bool too
	if (exists($settings{$var})) {
	    $settings{$var} = $val;
	    if ($var eq "bar-placement") {
		for (my $i = 0; $i < length($val); $i++) {
		    my $c = chr(vec($val, $i, 8));
		    $bar_orientation = "h" if ($c eq "h");
		    $bar_placement = "r" if ($c eq "r");
		}
	    }
	} else {
	    &usage_exit("unknown option '$var'");
	}
    }

    return 0;
}


sub trunc_label {
    my $str = shift;
    my $label_margin = shift;

    my $max_len = $label_margin / $char_width;
    return substr($str, 0, $max_len);
}


sub print_table {
#    my $filename = shift;

    $filename =~ /([^\/]+)$/;
    my $filebase = $1;
    $filebase =~ s/\.[^\.]+$//;   #! ok to just remove any extension?

    my $outfilename;
    if (defined($settings{'output-base'})) {
	$outfilename = $settings{'output-base'};
    } else {
	$outfilename = $filename;
	$outfilename =~ s/\.[^\.]+$//;   #! ok to just remove any extension?
    }
    $outfilename .= ".html";

    $DEBUG && print STDERR "filename $filename filebase $filebase\n";
    $DEBUG && print STDERR "html file $outfilename\n";

    open(TABLE, ">$outfilename");
    print TABLE "<table cellpadding=0 cellspacing=0 border=0>\n";
    unless ($settings{'no-col-labels'}) {
	print TABLE "<tr>";
	for (my $i = 0; $i < $num_table_cols; $i++) {
	    print TABLE "<td valign=bottom align=left><img src='".$filebase."_col_label_".$i.".png' /></td>";
	}
	print TABLE "<td></td><td></td></tr>\n";
    }
    for (my $i = 0; $i < $num_table_rows; $i++) {
	print TABLE "<tr>";
	for (my $j = 0; $j < $num_table_cols; $j++) {
	    print TABLE "<td valign=top align=left><img src='".$filebase."_".$i."_".$j.".png' /></td>";
	}
	unless ($settings{'no-row-labels'}) {
	    print TABLE "<td valign=top align=left><img src='".$filebase."_row_label_".$i.".png' /></td>";
	}
	if ($i == 0) {
	    print TABLE "<td rowspan=$num_table_rows valign=top align=left><img src='".$filebase."_key.png' /></td>";
	}
	print TABLE "</tr>\n";
    }
    print TABLE "</table>\n";
}
