#! /usr/bin/env perl
#---------------------------------------------------------------------------
#@COPYRIGHT :
#             Copyright 1998, Alex P. Zijdenbos
#             McConnell Brain Imaging Centre,
#             Montreal Neurological Institute, McGill University.
#             Permission to use, copy, modify, and distribute this
#             software and its documentation for any purpose and without
#             fee is hereby granted, provided that the above copyright
#             notice appear in all copies.  The author and McGill University
#             make no representations about the suitability of this
#             software for any purpose.  It is provided "as is" without
#             express or implied warranty.

# TO DO:
# 
# *) Allow col specs to change between rows
# *) Allow for any transparent MINC overlay (not only label vols)
# *) Allow for different volume ranging methods
# *) Check all args before processing (e.g., ranging)
# *) Allow x/y/z specs of slices (in addition to s/c/t)
# *) Provide for "intuitive" window/level settings "bright" "dim" etc

use Env qw/ TMPDIR /;
use File::Basename;
use File::Temp qw/ tempdir /;
use Getopt::Tabular;

use Cwd qw/ abs_path getcwd /;

use IO::File;

use ILT::LayoutInclude;
use ILT::LayoutUtils;
use ILT::ProgUtils;

use MNI::DataDir;

use strict;
use Storable qw/dclone/;
use FindBin;

$| = 1;

# User-modifiable globals
my $Verbose = 1;
my $Execute = 1;
my $Clobber = 0;
my $Debug   = 0;
my $TmpDir;

my $ProgramName = fileparse($0);

my($OutFile);
my(@Volumes);
my($Height, $Width) = (0, 0);
my($BGcolor) = 'black';
my($BoundingObject) = undef;
my($BoundingVolume) = undef;
my($RangeFloor) = undef;
my($Crop) = 0;
my(@RowSpec);
my(@GlobalRowSpec) = ();
my($AlignCoM) = 0;
my(@ColSpec) = qw(t-35 t10 t65 s-30 s60 c-90 c-25 c30); 
my($DefaultColsUsed) = 1;
my($AutoCols) = 0;
my($AutoCol_Planes) = 's,c,t';
my($Transpose) = 0;
my($FileTitle) = 0;
my($RepeatTitle) = 1;

my(%Progs); # Placeholder needed by &Run()

# highest label value allowed. Used when generating objects for surface overlay
my($MAX_LABEL) = 255;

# if given a volume for surface overlay, surfaces generated by marching cubes
# are stored here for reuse across rows ($expanded_label{file.mnc}{label}) 
my(%expanded_label);

# if masks are binarized, it is noted here to make sure it only happens once
my(%binarized);

# Other globals
my($Usage, $Help, $ModelDir,
   $layout, $n_rows, $n_cols,
   $view, $image_info, $row, $col, @obj_files, @view_dirs,
   @view, @plane_object, 
   $surface_cross_section,
   $bounding_object, $extra_space_around_bounding_object,
   $object_defining_view, %color_map );

Initialize();

#-----------------------------------------------------------------
#   Create image layout
#-----------------------------------------------------------------

$layout = ($Transpose) ? 
  ILT::ImageLayout->new_grid( $n_cols, $n_rows ) : 
  ILT::ImageLayout->new_grid( $n_rows, $n_cols );
$layout->horizontal_white_space( 3 );
$layout->vertical_white_space( 10 );
$layout->white_space_colour( $BGcolor );
   
#-----------------------------------------------------------------
#   Since clipping is not yet implemented, the following bounding
#   object specificiation is a temporary hack to allow specifying
#   a narrower region of interest than the whole volume
#
#   Actually, it's not really that much of a hack.  Rather than
#   letting the view define itself based on the scene to be rendered
#   it is letting the view defined itself based on some unrelated
#   scene object which represents the region of interest.  This seems
#   like a reasonably valid thing to do.
#-----------------------------------------------------------------

if (defined($BoundingVolume)  && ! defined($BoundingObject)) {
    # If we were given a bounding volume but no bounding object,
    # generate a (hopefully sensible) bounding object
    my @range = VolumeRange($BoundingVolume);
    my $t = $range[0];
    my $bv = $BoundingVolume;
    if ($range[0] == $range[1]) {
	# In case we were given an empty bounding volume
	my $ones = &TmpFile($BoundingVolume, 'ones');
	&Run(['minccalc', '-expression', 1, $BoundingVolume, $ones]) && die;
	$bv = $ones;
	$t = 0.5;
    }
    $BoundingObject = &TmpFile($bv, EXT => '.obj');
    &Run(['marching_cubes', $bv, $BoundingObject, $t]) && die;
}

if (defined($BoundingObject)) {
    $bounding_object = ILT::GeometricObject->new( $BoundingObject );
    $extra_space_around_bounding_object = 5;
}

#-----------------------------------------------------------------
#   Create a slice and view for each column
#-----------------------------------------------------------------

for( $col = 0;  $col < $n_cols;  ++$col ) {
    my($plane, $slice, $view) = @{ $ColSpec[$col] };

    $plane_object[$col] = 
      ILT::PlaneObject->new_canonical($plane, $slice);
    $view[$col] = ILT::View->new_canonical($view);
    #   Temporary modification of view to clip it, this will disappear when
    #   clipping is implemented.  You may comment out this line if not desired
    
    if (defined($BoundingObject)) {
	$object_defining_view = 
	  ILT::IntersectionObject->new($plane_object[$col], $bounding_object );
	
	SetClippedView($view[$col],
		       $object_defining_view,
		       $extra_space_around_bounding_object );
    }
}

#-----------------------------------------------------------------
#   Now describe each image in the grid
#-----------------------------------------------------------------
for( $row = 0;  $row < $n_rows;  ++$row )
{
   print "================ Processing row $row =================\n" if ($Verbose);

   #-----------------------------------------------------------------
   #   Create a volume and surface object(s) for each row
   #-----------------------------------------------------------------

   my(%colorSpec) = %{ $RowSpec[$row]{color} };

   my($volume_object) = ILT::VolumeObject->new( $RowSpec[$row]{volume} );
   if ($colorSpec{'type'} eq 'label') {
      $volume_object->interpolation( Nearest_neighbour_interpolation );
   }

   my($volume_overlaySpec) = $RowSpec[$row]{volume_overlay};
   if (defined($volume_overlaySpec)) {
      my($vol_ovl);
      foreach $vol_ovl (@$volume_overlaySpec) {
	 if ( $$vol_ovl{'type'} eq 'mnc' ){
	    if ($$vol_ovl{'opacity'} ne '' ) {
	       die "$ProgramName overlay opacity value '".$$vol_ovl{'opacity'}."' must be a number.\n" if not $$vol_ovl{'opacity'} =~ /[0-9]+(\.[0-9]*)?/;
	    }else{
	       $$vol_ovl{'opacity'} = 0.5;
	    }
	    $$vol_ovl{'object'} = ILT::VolumeObject->new($$vol_ovl{'file'});
	    $$vol_ovl{'object'}->interpolation( Nearest_neighbour_interpolation );
	 }
	 else{
	    &Getopt::Tabular::SetError("bad_value", "Bad filetype '".$$vol_ovl{'file'}."' -- must be .mnc");
	 }
      }
   }

   my($surface_overlaySpec) = $RowSpec[$row]{surface_overlay};
   if (defined($surface_overlaySpec)) {

      # list of surface overlays specs split from minc volume
      my(@split_overlay);

      my($surf_ovl);
      foreach $surf_ovl (@$surface_overlaySpec) {

	 if ($$surf_ovl{'type'} eq 'obj') {
	    if ($$surf_ovl{'color'} and $$surf_ovl{'color'} ne 'label') {
	       $$surf_ovl{'file'} = ColorObject($$surf_ovl{'file'}, $$surf_ovl{'color'});
	    }

	    $$surf_ovl{'object'} = ILT::GeometricObject->new($$surf_ovl{'file'});
	    # no need to split (we're already a surface object file)
	    push( @split_overlay, $surf_ovl) ;
	 }

	 if ($$surf_ovl{'type'} eq 'mnc') {

	    %color_map = loadColorMap("${ModelDir}labels.map") if not %color_map;

	    # add an overlay for each label in the minc volume

	    # get labels
	    my $tmp_hist = get_tmp_file( 'csv' );
	    my @cmd = ("mincstats", "-clobber", "-quiet", "-none", "-floor", "0.5","-max", "-integer_histogram", "-histogram", $tmp_hist, $$surf_ovl{'file'});
	    my @mincstats_output = `@cmd`;

	    # die if suspected that this minc file isn't a label volume
	    my $greatest_label = $mincstats_output[1];
	    chomp $greatest_label;
	    die "Too many labels in '$$surf_ovl{'file'}' to overlay surfaces\n" if $greatest_label > $MAX_LABEL;

	    my $fh = new IO::File $tmp_hist;
	    die "Unable to generate discrete histogram for '".$$surf_ovl{'file'}."'\n" if (! defined $fh);

	    my ($split_surface, %expanded_ovl);

	    LINE:
	    while (<$fh>) {
	       next LINE if /^\#/;
	       #<value> <frequency>
	       next if (not /\D*(\d+)\D+(\d+)/ && $1 && $2);

	       # don't lose track of any specs given at command line
	       %expanded_ovl = %$surf_ovl;

	       # keep track of surface extractions for reuse across rows
	       $split_surface = $expanded_label{ $$surf_ovl{'file'} }{$1};
	       if ( not $split_surface ){
		  $split_surface = get_tmp_file( 'obj' );
		  &Run( ["marching_cubes", $$surf_ovl{'file'}, $split_surface, $1-0.5, $1+0.5] ) && die;
		  $expanded_label{ $$surf_ovl{'file'} }{$1} = $split_surface;
	       }

	       $expanded_ovl{'file'} = $split_surface;
	       if ($$surf_ovl{'color'} and $$surf_ovl{'color'} ne 'label') {
		  $expanded_ovl{'file'} = ColorObject($expanded_ovl{'file'}, $expanded_ovl{'color'});
	       }
	       else{
		  $expanded_ovl{'file'} = ColorObject($expanded_ovl{'file'}, $color_map{$1});
	       }
	       $expanded_ovl{'object'} = ILT::GeometricObject->new($expanded_ovl{'file'});
	       push( @split_overlay, {%expanded_ovl} );
	    }
	    $fh->close;

	 }
      }
      # set new surface overlays to those split out of minc volume
      @$surface_overlaySpec = @split_overlay ;
   }

   for( $col = 0;  $col < $n_cols;  ++$col )
   {
      #-----------------------------------------------------------------
      #   Create the scene hierarchy for one image as a union of:
      #       a colour-coded intersection of a slice and volume, and
      #       a cross section of a surface (intersection of slice and
      #                                     surface)
      #-----------------------------------------------------------------

      my($slice_object) = ILT::IntersectionObject->new($plane_object[$col],
	 $volume_object);


      my($colour_object) = 
      ILT::ColourObject->new_volume_colouring($slice_object,
	 $volume_object, 
	 $colorSpec{'map'},
	 $colorSpec{'min'},
	 $colorSpec{'max'});

      if (defined($colorSpec{'file'})) {
	 $colour_object->usercc_filename($colorSpec{'file'});
      }

      my($scene_object) = $colour_object;

      if (defined($volume_overlaySpec)) {
	 my(@vol_objovl);
	 my($vol_ovl);
	 my($ovl_color);
	 foreach $vol_ovl (@$volume_overlaySpec) {
	    $ovl_color = defined $$vol_ovl{'color'} ? $$vol_ovl{'color'} : "${ModelDir}labels.map";

	    # if rendering as normal volume
	    if (  ! -f $ovl_color && 
	         ( $ovl_color =~ /gr[ae]y/ ||
	           $ovl_color =~ /hot/ ||
	           $ovl_color =~ /spect/ ) ){

	       # convert to scale
	      if ( $ovl_color =~ /gr[ae]y/  ) { $ovl_color = Gray_scale; }
		  elsif ( $ovl_color =~ /hot/   ) { $ovl_color = Hot_metal_scale; }
		  elsif ( $ovl_color =~ /spect/ ) { $ovl_color = Spectral_scale; }
		  else  { die "error processing color spec for volume overlay"; }

	       #TODO get rid of those undefs
	       my @extrema = VolumeRange($$vol_ovl{'file'}, { 'fullrange' => 1 } );

	       $scene_object = 
	       ILT::ColourObject->new_volume_colouring($scene_object,
		  $$vol_ovl{'object'},
		  $ovl_color,
		  $extrema[0], $extrema[1] );

	    }
	    # else map colors based on colorspec (default labels if not defined)
	    else{
	       # Binarize the overlay, if that's what the user wants
	       if ( $ovl_color =~ s/^[bB]\[(.*?)\]// ){
		   my $binspec = $1;
		   $ovl_color = $ovl_color ? "1" . $ovl_color : "1:red";

		   # Binarize the whole volume for the first column, and we can reuse it
		   if ( $col == 0 ){
		       if ( ! exists $binarized{ $$vol_ovl{'file'} }{"$binspec$ovl_color"} ){
			   my ($bin_min, $bin_max) = split( ',', $binspec );
			   my @mm_opt;
			   if ( defined $bin_min && $bin_max ){
			       @mm_opt = ('-segment', '-const2', $bin_min, $bin_max );
			   }
			   elsif ( defined $bin_min ){
			       @mm_opt = ('-gt', '-const', $bin_min);
			   }
			   elsif ( defined $bin_max ){
			       @mm_opt = ('-lt', '-const', $bin_max);
			   }
			   else {
			       die "ERROR: could not parse volume overlay binarization color specification: '$ovl_color'\n";
			   }
			   my $bin_file = &TmpFile($$vol_ovl{'file'}, 'thresholded');
			   &Run( ['mincmath', @mm_opt, $$vol_ovl{'file'}, $bin_file] ) && die;

			   $binarized{ $$vol_ovl{'file'} }{"$binspec$ovl_color"} = $bin_file;
		       }
		       $$vol_ovl{'object'} = ILT::VolumeObject->new($binarized{ $$vol_ovl{'file'} }{"$binspec$ovl_color"});
		       $$vol_ovl{'object'}->interpolation( Nearest_neighbour_interpolation );
		   }
	       }
	       $scene_object = 
	       ILT::ColourObject->new_volume_colouring($scene_object,
		  $$vol_ovl{'object'},
		  Usercc_scale,
		  0, 255 );

	       my $color_map = $ovl_color; 

	       # if not a file, treat as a color map string
	       if ( ! -f $ovl_color
		  && $ovl_color =~ 
		  /((^|,)((\d+:)?([a-zA-Z]+|[0-9]+(\.[0-9]+)?\s+[0-9]+(\.[0-9]+)?+\s+[0-9]+(\.[0-9]+)?+)))+$/){

		  # convert to color map file
		  $color_map = generate_color_map( $ovl_color ); 
	       }
	       #if user-specified, there are problems
	       elsif( ! -f $ovl_color && defined $$vol_ovl{'color'} ) {
		  warn "Ignoring your volume overlay color spec '$ovl_color'\n";
	       }

	       $scene_object->usercc_filename($color_map);

	    }
	    $scene_object->under_colour( "transparent" );
	    $scene_object->opacity( $$vol_ovl{'opacity'} );

	    if (@vol_objovl) {
	       $scene_object = ILT::UnionObject->new( $scene_object, @vol_objovl );
	    }
	 }
      }
      if (defined($surface_overlaySpec)) {
	 my(@surf_objovl);
	 my($surf_ovl, $line_width);
	 foreach $surf_ovl (@$surface_overlaySpec) {
	    my($surf_objovl) = 
	    ILT::IntersectionObject->new($plane_object[$col],$$surf_ovl{'object'});


	    if ( defined($$surf_ovl{'thick'}) ){
	       # multiply if first char is 'x'
	       $$surf_ovl{'thick'} =~ /^(x?)(.*)/;
	       if ( $1 ){
		  $line_width = LineWidth($RowSpec[$row]{volume});
		  $line_width *= $2;
	       }
	       else{
		  $line_width = $2
	       }
	    }
	    else{
	       $line_width = LineWidth($RowSpec[$row]{volume});
	    }
	    $surf_objovl = ILT::RenderObject->new($surf_objovl);
	    $surf_objovl->line_width($line_width);

	    push(@surf_objovl, $surf_objovl);
	 }

	 if (@surf_objovl) {
	    $scene_object = ILT::UnionObject->new( $scene_object, @surf_objovl );
	 }
      }

      $image_info = ILT::ImageInfo->new( $scene_object, $view[$col] );
      $image_info->background_colour( $BGcolor );


      #-----------------------------------------------------------------
      #   Attach the image info to the layout manager
      #-----------------------------------------------------------------

      if ($Transpose) {
	 $layout->image_info( $layout->row_col_to_index($n_cols - $col - 1, $row),
	    $image_info );
      }
      else {
	 $layout->image_info( $layout->row_col_to_index($n_rows - $row - 1, $col),
	    $image_info );
      }
   }
}

#-----------------------------------------------------------------
#   Render the images and create the output file (in rgb)
#-----------------------------------------------------------------

$layout->generate_image( $OutFile, $Width, $Height );

#-----------------------------------------------------------------
#   Convert image to final format if not rgb.
#-----------------------------------------------------------------

if ($OutFile !~ /\.rgb$/) {
    # This works only if the output image is NOT a .rgb, because
    # of a silly bug in mogrify which loses the image header
    # (otherwise we could use ILT/SceneObject/TextObject.pm).

    AnnotateImage( $OutFile, 10, 0 );
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : AnnotateImage
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: 
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 2006/06/20, Claude Lepage
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub AnnotateImage ( $$$ ) {

    my $output = shift;
    my $text_width_offset = shift;
    my $text_height_offset = shift;

    my $PointSize = 16;
    my $Font = 'Helvetica';

    # Get global position of images by rows and columns.

    my( @x_pos, @y_pos, @x_size, @y_size );
    my $header = $layout->header();
    my $footer = $layout->footer();
    $layout->compute_image_sizes_and_positions( $Width, $Height, 2 * $header->height(),
                                                2 * $footer->height(), \@x_pos, \@y_pos,
                                                \@x_size, \@y_size );

    # Issue command to draw each label, left justified.
    my $row;
    my @DrawText = ( "-font", $Font );
    my $DrawSomething = 0;
    for( $row = 0; $row < $n_rows; $row++ ) {
        my $title = $RowSpec[$row]{title};
	if (defined $title && $title) {
	    my $index = ($Transpose) ? $layout->row_col_to_index( 0, $row ) : $layout->row_col_to_index( $row, 0 );
	    my $x = ($x_pos[$index] + $text_width_offset);
	    my $y = ($y_pos[$index] + $text_height_offset);
	    push(@DrawText, '-annotate', "0x0+${x}+${y}", "'$title'");

	    if( $RepeatTitle ){
		# Save the label in its own image file
		(my $tmp_tag = $title) =~ s/\s/_/g;
		my $tmp_label = &TmpFile("label_row_$row", EXT=>'.png');
		&Run( ['convert', '-pointsize', $PointSize, '-font', $Font, "'label:$title'", $tmp_label] ) && die;

		# Get the width of the row
		my $identify_row = `identify $output`;
		my $row_width;
		my $repeat = 1;
		if( $identify_row !~ /^\S+\s\S+\s(\d+)x/ ){
		    warn "WARNING: could not determine width in pixels of the row\n";
		    $repeat = 0;
		}
		else {
		    $row_width = $1;
		}
		
		# Get the width of the label
		my $identify_label = `identify $tmp_label`;
		my $label_width;
		if( $identify_label !~ /^\S+\s\S+\s(\d+)x/ ){
		    warn "WARNING: could not determine width in pixels of title $title";
		    $repeat = 0;
		}
		else {
		    $label_width = $1;
		}
		
		# Repeat the title across the row
		while( ($repeat) && (($x += $label_width + 50) < $row_width ) ){
		    push(@DrawText, '-annotate', "0x0+${x}+${y}", "'$title'");
		}
	    }
	    $DrawSomething = 1;
	}
    }

    if ($DrawSomething) {
	&Run(['mogrify', '-stroke', 'green', '-pointsize', $PointSize, @DrawText, $output]) && die;
    }
}

# ------------------------------ MNI Header ----------------------------------
#@NAME       : CreateInfoText
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: 
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 98/04/16, Alex Zijdenbos
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub CreateInfoText
{
   $Usage = <<USAGE;
Usage: $ProgramName <out.{rgb|jpg|tif|...}> [<in.mnc> ...] [options]
       $ProgramName -help
USAGE

   $Help = <<HELP;
$ProgramName 
creates a verification image using David MacDonald\'s ILT library. The default
output image format is IRIX rgb; however, if the output file name does not have
a .rgb extension, ImageMagick\'s \`convert\' will be used to convert it. Note
that the output file and possible input files should be specified before any 
other options.
HELP

   Getopt::Tabular::SetHelp ($Help, $Usage);
}

# ------------------------------ MNI Header ----------------------------------
#@NAME       : SetupArgTables
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: 
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 98/04/16, Alex Zijdenbos
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub SetupArgTables
{
    my (@args) = 
	(["General options", "section"],
	 ["-verbose|-quiet", "boolean", 1, \$Verbose, "Be verbose"],
	 ["-debug", "boolean", 1, \$Debug, "Be more verbose"],
	 ["-clobber", "boolean", 1, \$Clobber, "Clobber an existing output file"],
	 ["-execute", "boolean", 1, \$Execute, "Execute commands"],
	 ["Specific Options", "section"],
	 ["-background_color", "string", 1, \$BGcolor,
 	  "the 'white space' color [default: $BGcolor]", "<color>"],
	 ["-bounding_object", "string", 1, \$BoundingObject,
 	  "the bounding object to use for clipping", "<bounds.obj>"],
	 ["-bounding_volume", "string", 1, \$BoundingVolume,
 	  "the volume to use for the extent of the image viewport", "<volume.mnc>"],
	 ["-range_floor", "float", 1, \$RangeFloor,
	  "floor for auto-range calculation"],
	 ["-crop", "boolean", 1, \$Crop, "crop each input image to its foreground using some thresholding and morphology magic"],
	 ["-row", "call", [\@RowSpec], \&ParseRowOption,
	  "specifications for a single row. Multiple rows should be specified using multiple -row options. Multiple overlay specifications are allowed. If no <row.mnc> is specified, input volumes are taken from the global <in.mnc> list.\n                                        --------------------------------------------------------colorspec -- specify the color space in which to render the volume for this row. Automatically calculates min/max pixel intensities over each slice. A mask can be specified (voxels within 0.5 of <binvalue> (default: 1) are included from the mask volume) for min/max pixel intensity calculation which defines the region over which to calculate intensities. Min and/or max intensities can be set explicitly, or the automatically detected min/max scaled by specifying a percent.   color:{gray|hot|spect|label|<file>}[:<min>[:<max>]]\n  color:{gray|hot|spect|label|<file>}[:<mask.mnc>[:<binvalue>]]\n--------------------------------------------------------overlayspec -- specify an overlay for the current row (can be *.obj or *.mnc). Surface overlays can be generated from label volumes where a surface is extracted for each label in the volume. The surface line thickness can be explicitly set with <thickness> (see ray_trace) or the create_verify_image default adjusted by a scaling factor (by prefixing <thickness> with an 'x'). Color can be specified for volume overlays as either a path to a custom color map, a comma-separated list of <label>:<value> pairs, or one of 'gray', 'hot' or 'spect' to overlay a regular scan. Note that the bare 'overlay:' spec is kept for backwards compatibility; full functionality can be achieved with 'volume_overlay:' and 'surface_overlay:'.\n  volume_overlay:{<label.mnc>[:<opacity>[:<colors>]]}\n  surface_overlay:{(<surf.obj>|<mask.mnc>)[:<color>[:<thickness>]]\n                     overlay:{<surf.obj>[:<color>[:<thickness>]]|<volume.mnc>[:<opacity>[:<colors>]]}\n                                      --------------------------------------------------------titlespec -- specify a title to draw on the current row                title:<string>                                    --------------------------------------------------------", "[<row.mnc>] [colorspec] [overlayspec] [titlespec]"],
	 ["-align_com", "boolean", 1, \$AlignCoM, "align input image origin to its CoM"],
	 ["-cols", "call", [\@ColSpec], \&ParseColOption,
	  "comma-separated list of column view specifications. Specifications start with a character indicating the plane to view ('t' for transverse, 's' for sagittal, 'c' for coronal) followed by slice (world) coordinates. Slice coordinates are specifies as <start>:<stop>:<step>. Start and stop can be left blank to slice to volume extremes. Blank step defaults to 1 [default: " . join(',', @ColSpec) ."]", "t<slice>|s<slice>|c<slice>[,...]"],
	 ["-autocols", "integer", 1, \$AutoCols,
	  "automatically add <nslices> regularly spaced slices in each direction. These slices are added to any columns specified via -cols", "<nslices>"],
	 ["-autocol_planes", "string", 1, \$AutoCol_Planes,
	  "comma-separated list of planes used by -autocols (example: 's,c')"],
	 ["-height", "integer", 1, \$Height,
	  "height of the output image [default: $Height]", "<height>"],
	 ["-width", "integer", 1, \$Width,
	  "width of the output image [default: $Width]", "<width>"],
	 ["-filetitle", "boolean", 1, \$FileTitle,
	  "add the filename as a title to each row which does not have an explicit title"],
	 ["-repeattitle|-norepeattitle", "boolean", 1, \$RepeatTitle,
	  "repeat titles across their entire row"],
	 ["-transpose|-notranspose", "boolean", 1, \$Transpose,
	  "transpose the image matrix. Note that -width and -height always apply to the final output image, i.e., after the transpose operation if specified [default is -notranspose]"]
	);
    
    \@args;
}

# ------------------------------ MNI Header ----------------------------------
#@NAME       : Initialize
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: 
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 98/04/16, Alex Zijdenbos
#@MODIFIED   :
#-----------------------------------------------------------------------------
sub Initialize
{
   my($argTbl) = SetupArgTables;
   my(@leftOverArgs);

   CreateInfoText();

   $TmpDir = File::Spec->tmpdir();
   $TmpDir = tempdir("${TmpDir}/${ProgramName}_XXXXX", CLEANUP => 1 );

   GetOptions ($argTbl, \@ARGV, \@leftOverArgs) || die "\n";
   if (@leftOverArgs < 1)  {
       warn $Usage;
       die "Incorrect number of arguments\n";
   }

   $OutFile = shift @leftOverArgs;
   @Volumes = @leftOverArgs;

   $ENV{TMPDIR} = $TmpDir;

   if (-e $OutFile ){
	   if ( $Clobber ) {
		   unlink( $OutFile );
	   }
	   else{
		   die "Ouput file $OutFile exists; use -clobber to overwrite\n";
	   }
   }

   my($base, $dir, $ext) = fileparse($OutFile, qr/\.[^\.]*/);

   # Verify dimension specifications
   die "Please specify -width and/or -height\n" 
       if (($Width <= 0) && ($Height <= 0));

   # Get model directory
   $ModelDir = MNI::DataDir::dir('ILT');

   #-----------------------------------------------------------------
   #   Verify row specifications
   #-----------------------------------------------------------------

   # First, insert any global volumes into volume-less rowspecs
   my($row);
   foreach $row (@RowSpec) {
       if (!$$row{volume}) {
	   if (@Volumes) {
	       $$row{volume} = shift @Volumes;
	   }
	   else {
	       die "More row specifications than input volumes\n";
	   }
       }
   }

   # Next, create/add row specifications for any remaining global volumes
   my($volume);
   foreach $volume (@Volumes) {
       print "--- parsing global row options ---\n" if ($Debug);
       ParseRowOption('-row', [ $volume, @GlobalRowSpec ]);
   }   

   # Crop
   if ( $Crop ){
       for my $i (0..$#RowSpec){
	   my $vol = $RowSpec[$i]{volume};
	   my $bv = $vol;

	   my $dims;
	   &Run(['mincinfo', '-vardims', 'image', $vol], \$dims) && die;
	   chomp $dims;
	   my @dims = split(' ', $dims);

	   # Make sure we have a 3D volume for mincmorph
	   if (@dims > 3) {
	       my $avgdim = (grep(!/space/, @dims))[0];
	       my $scalar = &TmpFile($vol, 'scalar');
	       &Run(['mincaverage', '-avgdim', $avgdim, $vol, $scalar]) && die;
	       $bv = $scalar;
	   }
	   
	   my $t; 
	   &Run(['mincstats', '-quiet', '-biModalT', $bv], \$t) && die;
	   chomp $t;
	 
	   my $morph = &TmpFile($bv, 'morph');
	   &Run(['mincmorph', '-clobber', '-successive', "B[${t}]EEEGB[0.5:1.5]DDDDDDD", $bv, $morph]) && die;
  
	   my $cropped = &TmpFile($morph, 'cropped');
	   &Run(['autocrop', '-clobber', '-bbox', $morph, '-bbox_threshold', 0.5, $vol, $cropped]) && die;
	   $RowSpec[$i]{volume} = $cropped;
       }
   }

   # Align center of mass
   if ( $AlignCoM && @RowSpec > 1){
       for my $i (0..$#RowSpec){
	   my $vol = $RowSpec[$i]{volume};

	   my @com = &CoM($vol); 
	   my @trans = map{ -1 * $_ } @com;

	   my $xfm = &TmpFile($vol, 'com', EXT => '.xfm');
	   my $com_xfm = "param2xfm $xfm -translation @trans";
	   print "$com_xfm\n" if $Verbose;
	   system( $com_xfm ) && die $!;

	   my $res = &TmpFile($vol, 'res');
	   my $resample_com = "mincresample -transform $xfm -tfm_input_sampling -nearest $vol $res";
	   print "$resample_com\n" if $Verbose;
	   system( $resample_com ) && die $!;

	   $RowSpec[$i]{volume} = $res;
       }
   }


   # Verify all row specifications and collect smallest bounding box
   # across al volumes
   my @start;
   my @stop;
   $n_rows = @RowSpec;
   my($rowCtr) = 0;

   VolumeBounds($BoundingVolume, \@start, \@stop) if ( defined $BoundingVolume );
   foreach $row (@RowSpec) {
       my($volume) = $$row{volume};
       die "Error parsing row specifications\n" if (!$volume);
       die "Volume $volume is not a file\n" if (! -f $volume);
       
       print "\n----------------------\nRow:     $rowCtr\n" if ($Verbose);
       print "Volume:  $volume\n" if ($Verbose);

       my($title) = $$row{title};
       if ($FileTitle && !defined($$row{title})) {
	   $$row{title} = $volume;
       }
       if (defined($$row{title})) {
	   print "Title:   $$row{title}\n" if ($Verbose);
       }

       # Explicitly decompress volume to avoid repeated decompressions
       $volume = Uncompress($TmpDir, $volume);
       die "Volume $volume is not a file\n" if (! -f $volume);
       $$row{volume} = $volume;

       my($color) = $$row{color};
       if (defined($color)) {
	   ConvertColorSpec($color, $volume);
	   print "Color:   " . HashToStr($color) . "\n" if ($Verbose);
       }

       # Update volume extent
       if ( ! defined $BoundingVolume ){
	   VolumeBounds($volume, \@start, \@stop);
       }

       my($volume_overlays) = $$row{volume_overlay};
       if (defined($volume_overlays)) {
	   foreach my $vol_ovl (@$volume_overlays) {
	       $$vol_ovl{'file'} = Uncompress($TmpDir, $$vol_ovl{'file'});
	       die "Overlay $$vol_ovl{'file'} is not a file\n" if (! -f $$vol_ovl{'file'});
	       ($$vol_ovl{'type'}) = $$vol_ovl{'file'} =~ /\.(mnc)/;
	       if (!defined($$vol_ovl{'type'})) {
		   die "Unknown type for volume overlay file " . $$vol_ovl{'file'} . 
		       ". Must be .mnc\n";
	       }
	       print "Overlay: " . HashToStr($vol_ovl) . "\n" if ($Verbose);
	   }
       }

       my($surface_overlays) = $$row{surface_overlay};
       if (defined($surface_overlays)) {
	   foreach my $surf_ovl (@$surface_overlays) {
	       $$surf_ovl{'file'} = Uncompress($TmpDir, $$surf_ovl{'file'});
	       die "Overlay $$surf_ovl{'file'} is not a file\n" if (! -f $$surf_ovl{'file'});
	       ($$surf_ovl{'type'}) = $$surf_ovl{'file'} =~ /\.(obj|mnc)/;
	       if (!defined($$surf_ovl{'type'})) {
		   die "Unknown overlay type for file " . $$surf_ovl{'file'} . 
		       ". Must be either .obj or .mnc\n";
	       }
	       print "Overlay: " . HashToStr($surf_ovl) . "\n" if ($Verbose);
	   }
       }

       print "----------------------\n" if ($Verbose);

       $rowCtr++;
   }

   #-----------------------------------------------------------------
   #   Verify column specifications
   #-----------------------------------------------------------------

   if ($AutoCols) {
       @ColSpec = () if ($DefaultColsUsed);

       my @plane = qw/ s c t /;
       my @autocolumns = split(',', $AutoCol_Planes );

       # If this is a slice, we can only need a single frame
       my $SliceDim = &IsSlice( $RowSpec[0]->{volume} );
       if( $SliceDim >= 0 ){
	   @autocolumns = ($plane[$SliceDim]);
	   $AutoCols = 1;
       }


       foreach my $i (0, 1, 2) {
	   next unless grep( /$plane[$i]/, @autocolumns );
	   my $extent = $stop[$i] - $start[$i];
	   my $int = $extent/($AutoCols + 1);
	   my $slice = sprintf("%.6f", $start[$i] + $int);
	   for my $j (1..$AutoCols) {
	       push(@ColSpec, "$plane[$i]$slice");
	       $slice = sprintf("%.6f",$slice + $int);	       
	   }
       }
   }

   @ColSpec = map{ ExpandColSpec( $_, \@start, \@stop ) } @ColSpec;
   @ColSpec = map { [ ConvertView($_, \@start, \@stop) ] } @ColSpec;
   
   $n_cols = @ColSpec;
}

# Expand range specifications and convert voxel coordinates to world coordinates
sub ExpandColSpec {
    my $col = shift;
    my $start = shift;
    my $stop = shift;

    # Single slice
    if ( $col =~ /^(c|s|t)(-?\d+(\.\d*)?)$/ ) {
	return $1.$2;
    }
    # Range
    elsif ( $col =~ /^(c|s|t)(-?\d*(\.\d+)?):(-?\d*(\.\d*)?)(:(-?\d+(\.\d*)?))?$/ ) { 
	my $plane = $1;
	my %plane = ( 's'=>0, 'c'=>1, 't'=>2 );
	my $dimstart = $$start[ $plane{$plane} ];
	my $dimstop = $$stop[ $plane{$plane} ];

	# Get bounds and step
	my ($from, $to, $step) = ($2,$4,$7);
	print "from $from to $to by $step\n";

	# Default step 1
	$step = 1 if ! $step;

	# Slice empties to extreme
	$from = $step>0 ? $dimstart : $dimstart if $from eq '';
	$to = $step>0 ? $dimstop : $dimstart if $to eq '';

	# Sanity check
	die "Error parsing colum spec '$col' - zero step\n" if $step == 0;
	die "Error parsing colum spec '$col' - bad bounds\n" if ($from < $to && $step<0) || ($from > $to && $step>0 );

	# Expand
	my @expanded;
	for( my $i=$from ; ($step > 0 ? $i<$to : $i>$to) ; $i+=$step ){
	    push( @expanded, sprintf("%s%.6f",$plane,$i) );
	}
	return @expanded;
    }
    else {
	die "Error parsing column spec $col\n";
    }
}

# ------------------------------ MNI Header ----------------------------------
#@NAME       : SetupArgTables
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: 
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 98/04/16, Alex Zijdenbos
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub ConvertView {
    my($spec, $start, $stop) = @_;

    my(@viewSpec);
    my($view);
    my($plane, $slice) = $spec =~ /^([^\d\-]+)([\d\-\.]+)$/;

    print "Plane: $plane Slice: $slice\n" if ($Verbose);

    if (!defined($plane) || !defined($slice)) {
	die "Couldn't figure out column specification $spec\n";
    }

    if ($plane =~ /^s/) {
	$plane = Sagittal_axis;
	$view  = Right_view;
	if (($slice < $$start[0]) || ($slice > $$stop[0])) {
	    $slice = $$start[0] if ($slice < $$start[0]);
	    $slice = $$stop[0] if ($slice > $$stop[0]);
	    warn "Colspec $spec is out of bounds [$$start[0], $$stop[0]]; truncated to slice $slice\n";
	}
    }
    elsif ($plane =~ /^t/) {
	$plane = Transverse_axis;
	$view  = Top_view;
	if (($slice < $$start[2]) || ($slice > $$stop[2])) {
	    $slice = $$start[2] if ($slice < $$start[2]);
	    $slice = $$stop[2] if ($slice > $$stop[2]);
	    warn "Colspec $spec is out of bounds [$$start[2], $$stop[2]]; truncated to slice $slice\n";
	}
    }
    elsif ($plane =~ /^c/) {
	$plane = Coronal_axis;
	$view  = Back_view;
	if (($slice < $$start[1]) || ($slice > $$stop[1])) {
	    $slice = $$start[1] if ($slice < $$start[1]);
	    $slice = $$stop[1] if ($slice > $$stop[1]);
	    warn "Colspec $spec is out of bounds [$$start[1], $$stop[1]]; truncated to slice $slice\n";
	}
    }
    else {
	die "Unknown plane specification $plane\n";
    }

    ($plane, $slice, $view);
}

#-----------------------------------------------------------------
#   Define the view based on some scene object other than that being
#   rendered.
#-----------------------------------------------------------------

sub SetClippedView( $$$ ) {
    my( $view )        = arg_object( shift, "ILT::View" );
    my( $object_defining_view ) = arg_object( shift, "ILT::SceneObject" );
    my( $extra_space_around_bounding_object ) = arg_real( shift, 0, 1e30 );
    end_args( @_ );
    
    my( $view_copy, @bbox );
    
#--- make a temporary copy of the view
    
    $view_copy = $view->copy();
    
#--- define the default view based on the object
    
    $view_copy->compute_view_for_object( $object_defining_view );
    
#--- explicitly set bounding box of the view, so that it doesn't get
#--- automatically computed
    
    @bbox = $view_copy->bounding_box();
    
    $bbox[0] -= $extra_space_around_bounding_object;
    $bbox[1] += $extra_space_around_bounding_object;
    $bbox[2] -= $extra_space_around_bounding_object;
    $bbox[3] += $extra_space_around_bounding_object;
    $bbox[4] -= $extra_space_around_bounding_object;
    $bbox[5] += $extra_space_around_bounding_object;
    
    $view->bounding_box( @bbox );
}

sub ParseRowOption {
   my($opt, $args, $dest) = @_;

   print "ParseRowOption args: \"" . join(' ', @$args) . "\"\n" if ($Debug);

   # Defaults
   my $explode = 0;
   my $explode_dim;

   my($volume) = shift @$args;

   # Verify that an argument was specified
   if (!defined($volume)) {
      &Getopt::Tabular::SetError("bad_value", "Option $opt must be followed by something");
      return 0;
   }

   # Strip off volume tags (if specifed)
   if( $volume =~ s/^explode(-([^:]+))?:// ){
       $explode = 1;
       $explode_dim = $2;
   }

   # Check whether or not the first argument is a valid minc volume
   if (!IsMincVolume($volume)) {
      unshift @$args, $volume; 
      $volume = 0;
      @GlobalRowSpec = @$args;
   }

   my($color)            = undef;
   my($title)            = undef;
   my($surface_overlays) = undef;
   my($volume_overlays)  = undef;

   while (@$args && $$args[0] !~ /^-/ && $$args[0] =~ /:/) {
      my(@spec) = split(':', shift @$args);

      my($type) = shift @spec;

      print "Type: $type\n" if ($Debug);

      TYPE_PARSE:{
	 if ($type eq 'color') {
	    if (defined($color)) {
	       warn "Warning: ignoring color re-specification \'@spec\'\n";
	    }
	    else {
	       $color = { 'type' => shift @spec };

	       my($opt1) = shift @spec;
	       my($opt2) = shift @spec;

	       # If doesn't look like a number, consider it a mask
	       if ( defined $opt1 && $opt1 !~ /[0-9]+(\.[0-9])?/ ){
		   $$color{'mask'} = $opt1;
		   $$color{'binvalue'} = defined $opt2 ? $opt2 : 1;
	       }
	       else { # it's a number
		   $$color{'min'} = $opt1;
		   $$color{'max'} = $opt2;
	       }
	   }
	 } elsif ($type eq 'overlay') {
	    # for backwards compatability 
	    $spec[0] =~ /\.(obj|mnc)/;

	    if ( $1 eq 'obj' ){ $type = 'surface_overlay'; redo TYPE_PARSE;  }
	    elsif ( $1 eq 'mnc' ){ $type = 'volume_overlay'; redo TYPE_PARSE; }
	    else{
	       &Getopt::Tabular::SetError("bad_value", "Bad file type \'" . $spec[0] . "\'; this must be either .obj or .mnc ");
	    }

	 } elsif ($type eq 'volume_overlay') {
	    my($volume_overlay) = { 'file' => shift @spec };
	    $$volume_overlay{'opacity'} = shift @spec if (@spec);

	    # treat the rest of this spec as a color
	    if ( @spec ){
	       my $color_spec = join(':',@spec);
	       $$volume_overlay{'color'} = join(':',@spec);
	    }

	    push(@$volume_overlays, $volume_overlay);
	 } elsif ( $type eq 'surface_overlay' ) {
	    my($surface_overlay) = {'file' => shift @spec };
	    $$surface_overlay{'color'} = shift @spec if (@spec);
	    $$surface_overlay{'thick'} = shift @spec if (@spec);

	    push(@$surface_overlays, $surface_overlay);
	 } elsif ($type eq 'title') {
	    $title = shift @spec;
	 } else {
	    &Getopt::Tabular::SetError("bad_value", "Unknown specification '$type:'; this must be one of {overlay:|color:|volume_overlay|:surface_overlay:|title:}");
	    return 0;
	 }
      }
   }

   if (!defined($color)) {
      $color = { 'type' => 'hot' };
   }

   my(%rowSpec) = (volume => $volume,
      color  => $color,
      title  => $title);
   $rowSpec{'volume_overlay'} = $volume_overlays if defined($volume_overlays);
   $rowSpec{'surface_overlay'} = $surface_overlays if defined($surface_overlays);

   if(! $explode){
       push(@RowSpec, \%rowSpec);
   }
   else{
       my $explode_base = "$TmpDir/explode";
       my $explode_dir = $explode_base;
       my $i = 0;
       while(-d $explode_dir){
	   $explode_dir = "${explode_base}_" . $i++;
       }
       # TODO: can the be removed for an additional field in the rowspec to
       # tell ILT an index to lookup in the un-exploded volume?
       my @split_volume = ('split_volume.pl', $volume, '-destdir', $explode_dir, '-remove_dim');
       push( @split_volume, "-dimname", $explode_dim ) if defined $explode_dim;
       &Run(\@split_volume) && die;

       $i = 0;
       foreach my $slice (glob("$explode_dir/*mnc")){
	   my $rowSpec = dclone(\%rowSpec);
	   $$rowSpec{title} = sprintf("%s (frame %d)", basename($rowSpec{volume}), $i++);
	   $$rowSpec{volume} = $slice;
	   push(@RowSpec, $rowSpec);
	   print "$slice\n";
       }
   }

   return 1;
}

sub ParseColOption {
    my($opt, $args, $dest) = @_;

    $DefaultColsUsed = 0;

    @$dest = split(',', shift @$args);
}

sub ConvertColorSpec {
    my($colorSpec, $volume) = @_;

    my @extrema = VolumeRange($volume, $colorSpec);

    # Scale the colors, if that's what the user wants
    if ( $$colorSpec{'min'} =~ s/\%$// ){
       $$colorSpec{'min'} *= $extrema[0] / 100;
    }
    else{
       $$colorSpec{'min'} = $extrema[0];
    }

    if ( $$colorSpec{'max'} =~ s/\%$// ){
       $$colorSpec{'max'} *= $extrema[1] / 100;
    }
    else{
       $$colorSpec{'max'} = $extrema[1];
    }

    # Assign the type
    if ($$colorSpec{'type'} =~ /gr[ae]y/) {
	$$colorSpec{'map'} = Gray_scale;
    }
    elsif ($$colorSpec{'type'} =~ /hot/) {
	$$colorSpec{'map'} = Hot_metal_scale;
    }
    elsif ($$colorSpec{'type'} =~ /spect/) {
	$$colorSpec{'map'} = Spectral_scale;
    }
    elsif ($$colorSpec{'type'} =~ /label/) {
	$$colorSpec{'map'} = Usercc_scale;
	$$colorSpec{'file'} = "${ModelDir}labels.map";
	$$colorSpec{'min'} = 0;
	$$colorSpec{'max'} = 255;
    }
    elsif (-f $$colorSpec{type}) {
	$$colorSpec{'file'} = $$colorSpec{'type'};
	$$colorSpec{'type'} = 'file';
	$$colorSpec{'map'}  = Usercc_scale;
	$$colorSpec{'min'} = 0;
	$$colorSpec{'max'} = 255;
    }
}

sub VolumeRange {
   my($volume) = shift;

   my $colorspec = shift;

   my($cmd, $min, $max);

   if( $$colorspec{'mask'} ){
       my $mask = $$colorspec{'mask'};
       my $binvalue = $$colorspec{'binvalue'};
      die "Mask '$mask' for color specification is not a minc volume.\n" if ! IsMincVolume($mask);

      $cmd = "mincstats -quiet -mask $mask -mask_binvalue $binvalue -pctT 0.1 $volume";
      $cmd .= " -floor $RangeFloor" if defined $RangeFloor;
      $min = `$cmd 2>&1`;
      die "\nError executing \"$cmd\": $min" if $?;

      $cmd = "mincstats -quiet -mask $mask -mask_binvalue $binvalue -pctT 99.9 $volume";
      $max = `$cmd 2>&1`;
      die "\nError executing \"$cmd\": $max" if $?;

      chomp ($min, $max);
  }
  elsif ( $$colorspec{'fullrange'} ){
      warn "WARNING: fullrange specified, so ignoring explicate 'min' and/or 'max'\n"
	  if $$colorspec{'min'} || $$colorspec{'max'};
      my $cmd = "mincstats -quiet -min -max $volume";
      $cmd .= " -floor $RangeFloor" if defined $RangeFloor;
      ($min, $max) = `$cmd 2>&1`;
      die "\nError executing \"$cmd\"" if $?;
      chomp( $min, $max );
      $min += 0.1;
  }
  else {
       $min = defined $$colorspec{'min'} ? $$colorspec{'min'} : '100%';
       $max = defined $$colorspec{'max'} ? $$colorspec{'max'} : '100%';

       if ( $min =~ s/\%$// ){
	   my $cmd = "mincstats -quiet -pctT 0.1 $volume";
	   $cmd .= " -floor $RangeFloor" if defined $RangeFloor;
	   my $ms_min = `$cmd 2>&1`;
	   die "Error executing \"$cmd\": $ms_min" if $?;
	   chomp $ms_min;
	   $min = $ms_min * $min / 100;
       }
       if ( $max =~ s/\%$// ){
	   my $cmd = "mincstats -quiet -pctT 99.9 $volume";
	   $cmd .= " -floor $RangeFloor" if defined $RangeFloor;
	   my $ms_max = `$cmd 2>&1`;
	   die "Error executing \"$cmd\": $ms_max" if $?;
	   chomp $ms_max;
	   $max = $ms_max * $max / 100;
       }

   }

   return ($min, $max);
}

sub IsSlice {
    my $vol = shift;
    
    my $cmd = "mincinfo -error_string 999 -dimlength xspace -dimlength yspace -dimlength zspace $vol";
    print $cmd . "\n" if $Verbose;
    my @dims = `$cmd`;
    die $! if $?;
    chomp @dims;

    die "Unable to get dimension information from volume $vol\n" if (@dims < 3);

    if ($dims[0] <= 1) {
	return 0;
    }
    elsif ($dims[1] <= 1) {
	return 1;
    }
    elsif ($dims[2] <= 1) {
	return 2;
    }
    
    return -1;
}

sub ColorObject {
    my($obj, $color) = @_;

    if (defined($color)) {
	my($temp) = get_tmp_file( "obj" );
	&Run(['set_object_colour', $obj, $temp, "'$color'"]) && die;
	$obj = $temp;
    }

    return $obj;
}

sub HashToStr {
    my($href) = @_;
    my($key);
    my($string);
    foreach $key (keys %$href) {
	if (!defined($string)) {
	    $string = "$key: $$href{$key}";
	}
	else {
 	    $string .= " $key: $$href{$key}";
	}
    }

    $string;
}

sub IsMincVolume {
    my($volume) = @_;
    
    return ($volume =~ /\.mnc/);
}
	
# ------------------------------ MNI Header ----------------------------------
#@NAME       : &Uncompress
#@INPUT      : $tmp_dir - directory to uncompress files to
#              @originals - list of files to consider for uncompression
#@OUTPUT     :
#@RETURNS    : array context: @originals, changed so that any the names
#                of any files that were compressed are now decompressed
#                and in $tmp_dir
#              scalar context: first element of @originals, possibly changed
#                to decompressed version
#@DESCRIPTION: Uncompresses (if applicable) compressed files to $tmp_dir.
#@METHOD     :
#@GLOBALS    :
#@CALLS      :
#@CREATED    : 1995/07/31, Greg Ward
#@MODIFIED   :
#-----------------------------------------------------------------------------
sub Uncompress
{
    my ($tmp_dir, @originals) = @_;
    my ($uncompressed, @uncompressed, $orig);
    
    foreach $orig (@originals)
    {
	if ($orig =~ /\.(Z|gz|z)$/)
	{
	    $uncompressed = $tmp_dir . "/" . fileparse($orig);
	    $uncompressed =~ s/\.(Z|gz|z)$//;
	    unless (-e $uncompressed)
	    {
		&Run(['gunzip', '-c', $orig, '>', $uncompressed]) && die;
	    }
	    push (@uncompressed, $uncompressed);
	}
	else
	{
	    push (@uncompressed, $orig);
	}
    }
    return @uncompressed if wantarray;
    return $uncompressed[0];
}

sub VolumeBounds {
    my ($volume, $start, $stop) = @_;

    # Some code adapted from autocrop
    my $cmd = "mincinfo $volume -error_string 0 " .
	"-attval xspace:start -attval xspace:step -dimlen xspace " .
	"-attval yspace:start -attval yspace:step -dimlen yspace " .
	"-attval zspace:start -attval zspace:step -dimlen zspace";
    my $diminfo = `$cmd`;
    die "Error executing \"$cmd\" on $volume\n" if $?;
    my @diminfo = split (/\n/, $diminfo);
    chomp @diminfo;

    my @volstart  = @diminfo[0,3,6];
    my @volstep   = @diminfo[1,4,7];
    my @vollength = @diminfo[2,5,8];
    my @volstop;

    foreach my $i (0, 1, 2) {
	$volstop[$i] = $volstart[$i] + $volstep[$i] * ($vollength[$i] - 1);
	($volstop[$i],$volstart[$i]) = ($volstart[$i],$volstop[$i])
	    if ($volstep[$i] < 0.0);
	
	my $dim = (qw(xspace yspace zspace))[$i];

	if ($Debug) {
	    printf "   %s: start=%g, stop=%g\n", $dim,$volstart[$i],$volstop[$i];
	}

	if (! defined $$start[$i]) {
	    $$start[$i] = $volstart[$i];
	}
	else {
	    $$start[$i] = $volstart[$i] if ($volstart[$i] > $$start[$i]);
	}

	if (! defined $$stop[$i]) {
	    $$stop[$i] = $volstop[$i];
	}
	else {
	    $$stop[$i] = $volstop[$i] if ($volstop[$i] < $$stop[$i]);
	}

	if ($Debug) {
	    printf "BB %s: start=%g, stop=%g\n", $dim,$$start[$i],$$stop[$i];
	}

	die "Unable to determine a useable bounding box (try -debug for more information)\n"
	    if ($$start[$i] > $$stop[$i]);
    }
}

sub Run {

    my $cmd = shift;

    my $stdout;

    # Default options
    my %runopt = (
	'CHECK_ARG_AGE' => 0,
	);

    # Extract directives from function call
    while (defined (my $arg = shift)) {
	if (defined $runopt{$arg}) {
	    $runopt{$arg} = shift;
	}
	else {
	    $stdout = $arg;
	}
    }

    # Perform some sanity checks on the command
    foreach my $arg (@$cmd) {
	die "Command @$cmd has empty arguments\n" if (! defined $arg);
    }

    # See if the prog knows -verbose, -debug or -tmpdir
    my @supported_opts;
    my $prog = $cmd->[0];
    if ($Progs{$prog}) {
	@supported_opts = @{ $Progs{$prog}{opts} };
    }
    else {
	die "Couldn't find $prog on your PATH\n"
	    if (! &FindProgram($prog));
	
	my $help = `$prog -help 2>&1`;

	# add verbose switch
	push( @supported_opts, $1) if ( $prog ne 'loop.pl' &&
	    				$help =~ /(-?-verbose)/);

	# add debug switch
	push( @supported_opts, $1) if ( $prog ne 'minccalc' && 
	    				$prog ne 'identify' &&
	    				$prog ne 'convert' &&
	    				$prog ne 'mogrify' &&
					$help =~ /(-?-debug)/);

	# If the prog supports -tmpdir, only add a flag here; we will
	# replace it later (for every invocation of the prog)
	push(@supported_opts, '-tmpdir') if ($help =~ /-tmpdir/);
	
	$Progs{$prog}{opts} = \@supported_opts;
	$Progs{$prog}{time} = 0;
    }
	    
    # Add options to command
    my @opts;
    if ( ! grep(/-quiet/, @$cmd) ){
	if ( $Verbose && (/(-?-verbose)/ ~~ @supported_opts) ){
	    push(@opts, $1);
	    push(@opts, 1) if ($prog =~ /minctracc$/); # Grmbl.
	}
	if ($Debug && ($prog !~ /minccalc$/) && (/(-?-debug)/ ~~ @supported_opts) ) {
	    push(@opts, $1);
	}
    }

    splice(@$cmd, 0, 1, $cmd->[0], @opts) if @opts; 

    # Now we have a final command line; remove any "in:" and "out:"
    # specs and collect in- and output file ages
    my $now = time;
    my $inputAge = -1;
    my $outputAge = -1;
    foreach my $arg (@$cmd) {
	if ($arg =~ /^(in|out):(.+)$/) {
	    my $type = $1;
	    $arg = $2;

	    if (-e $arg) {
		my $age = $now - (stat($arg))[9];

		if ($type eq 'in') {
		    $inputAge = $age if ($inputAge < 0 || $age < $inputAge);
		}
		elsif ($type eq 'out') {
		    $outputAge = $age if ($outputAge < 0 || $age > $outputAge);
		}
	    }
	    elsif ($type eq 'out') {
		$outputAge = 1e99;
	    }

	    print "outputAge: $outputAge inputAge: $inputAge\n" if $Debug;
	}
    }

    print "@$cmd\n" if ($Verbose);

    if ($runopt{CHECK_ARG_AGE} && ($inputAge >= 0) && ($outputAge >= 0) && ($inputAge > $outputAge)) {
	print "==> Not re-executing because all outputs are younger than all inputs\n" if ($Verbose);
	return 0;
    }

    my $exit = 0;

    if ($Execute) {
	my $pipe;
	my @out;
	my $t0 = time;
	#This is a nice list invocation but we'd like to catch stderr
	#as well 
	#my $pid = open($pipe, '-|', @$cmd);
	my $pid = open($pipe, "@$cmd 2>&1 |");
#	warn "PID: $pid exit: $exit \$\!: $! \$\?: $?\n" if $Debug;
	if ($pid) {
	    @out = <$pipe>;
	    close $pipe;
	    $exit = $?;
	}
	else {
	    $exit = 1;
	}
	
	if (@out) {
	    if (defined $stdout) {
		if (ref($stdout) eq "ARRAY") {
		    @$stdout = @out;
		}
		elsif (ref($stdout) eq "SCALAR") {
		    $$stdout = join("\n", @out);
		}
		elsif (! -e $stdout || -W $stdout) {
		    my $fh = new IO::File "> $stdout";
		    die "Couldn't open file $stdout: $!\n" if (! defined $fh);
		    
		    print $fh join("\n", @out);

		    $fh->close;
		}
		else {
		    die "I don't know what to do with $stdout (provided as output option to &Run)\n";
		}
	    }
	    elsif ($Verbose) {
		print @out;
	    }
	}
	    
#	warn "PID: $pid exit: $exit \$\!: $! \$\?: $?\n" if $Debug;
	print "@$cmd failed: $!\n"
	    if ($Verbose && $exit);

	my $elapsed = time - $t0;
	my ($D, $H, $M, $S) = (gmtime($elapsed))[7,2,1,0];
	print "Elapsed in $prog: $elapsed seconds ($D days, $H hours, $M minutes, $S seconds)\n" if $Verbose;
	$Progs{$prog}{time} += $elapsed;
    }

    return $exit;
}
sub FindProgram {
    my $prog = shift;

    if ($prog =~ /^\//) {
	return (-x $prog) ? 1 : 0;
    }
    else {
	foreach my $path (split(/:/, $ENV{PATH})) {
	    my $fullpath = "${path}/$prog";
	    return $fullpath if (-x $fullpath);
	}
    }

    return 0;
}

# reads color map from file specified and returns a hash of <label> => <color>
# TODO is there a standard hook for this that we could be using?
sub loadColorMap {
	my($file) = shift;

	my(%cm);

	my $fh = new IO::File $file;
	die "Unable to open color map'$file'\n" if (! defined $fh);

	LINE:
	while (<$fh>) {
		next LINE if /^\#/;

		# <label> <R> <G> <B> 
		next LINE if ! /^\s+(\d+)\s+([\.0-9]+)\s+([\.0-9]+)\s+([\.0-9]+)/;

		# simple sanity check
		if ( $2 > 1 or $3 > 1 or $4 > 1 ){
			die "Error parsing color map '$file': $1 $2 $3 $4 must each be in range (0,1).\n";
		}
		else{
			$cm{$1} = "$2 $3 $4";
		}
	}
	$fh->close;
	return %cm;
}

# generate a line width based on min step size for volume and an estimated
# scaling factor from native dimension to verification image
sub LineWidth {
   my $vol = shift;

   # [y-step, x-step, x-step, y-length, x-length, z-length]
   my $cmd = "mincinfo -attvalue yspace:step -attvalue xspace:step -attvalue zspace:step -dimlength yspace -dimlength xspace -dimlength zspace $vol";
   my @mincinfo = `$cmd`;
   chomp @mincinfo;

   my $minstep = min(@mincinfo[0..2]);
   $minstep = abs( $minstep );

   # get an estimate of scaling factor
   my $scale;

   if ( $Height ){
	   my $native_h_estimate = max( ($mincinfo[3], $mincinfo[4], $mincinfo[5]) ) * $n_rows;
	   $scale = $Height / $native_h_estimate if $Height;
   }
   elsif ( $Width ){
	   # transverse slice has width of coronal axis
	   $mincinfo[5] = $mincinfo[4];

	   my $native_w_estimate = 0;
	   foreach my $col (@ColSpec){
		   #$$col[0] is axis of slice: 0->s  1->c  2->t
		   $native_w_estimate += $mincinfo[$$col[0]+3];
	   }
	   $scale = $Width / $native_w_estimate if $Width;
   }

   # based on experiment: feel free to tinker if you don't like this function
   return (2.71828 ** ( (-0.79 * $scale) + 0.353 )) * $minstep * 1.1;
}

# generate a color map (255 labels) for specs on cmd line. The map is written to
# a tmp file. The return value is the filename of the color map.
sub generate_color_map{
	my $color_spec = shift;
	my $filename = get_tmp_file( "map" );

	my %default_color_map;
	my %cmd_line_color_map;
	my @cmd_line_unlabeled;

	foreach my $color_def (split( ',', $color_spec)){
		my @def = split( ':', $color_def);
		if ( @def == 1 ){
			push( @cmd_line_unlabeled, $def[0] );
		}elsif ( @def == 2 ){
			$cmd_line_color_map{$def[0]} = $def[1];
		}else{
			die "Something went terribly wrong with your color specification!";
		}
	}

	my $color;
	my $map = " 0 transparent\n";
	foreach my $label (1 .. 254){

		#look for a user-defined color
		$color = $cmd_line_color_map{$label};
		$color = shift @cmd_line_unlabeled if not defined $color;

		# if can't find one, grab defualt color
		if ( not defined $color ){
			%default_color_map = loadColorMap("${ModelDir}labels.map") if not %default_color_map;
			$color = $default_color_map{$label};
		}

		$map .= " $label $color\n";
	}
	$map .= " 255 0 0 0\n";

	my $fh = new IO::File "> $filename";
	print $fh $map;
	$fh->close;

	return $filename;
}

sub TmpFile {
    my $template = shift;

    # Default options
    my %opt = (
	'EXT' => '',
	'UNIQUE' => 1,
	);

    print "Template: $template Remaining args: @_\n" if $Debug;

    my @tag;
    while (defined (my $arg = shift)) {
	$arg =~ s/\s//g; # Remove any spaces from args
	print "Args: @_ arg: $arg\n" if $Debug;
	if (defined $opt{$arg}) {
	    $opt{$arg} = shift;
	    $opt{$arg} =~ s/\s//g;
	    print "Opt{$arg}: $opt{$arg}\n" if $Debug;
	}
	else {
	    push(@tag, $arg);
	    print "Tags: @tag\n" if $Debug;
	}
    }

    my ($base, $dir, $ext) = fileparse($template, qr/\.[^.]*(\.gz)?/);

    # Strip off the tmp file counter, but only if we generated the
    # filename as a TmpFile to begin with
    $base =~ s/\_\d+$// if ($dir =~ /^$TmpDir/);

    print "Base: $base Dir: $dir Ext: $ext TmpDir: $TmpDir\n" if $Debug;

    if ($opt{EXT}) {
	$ext = $opt{EXT};
    }
    else {
	$ext =~ s/\.gz//;
    }

    my $tempfilebase = "${TmpDir}/${base}";
    $tempfilebase .= '_' . join('_', @tag) if @tag;

    my $tempfile = "${tempfilebase}${ext}";

    print "Temp filename: $tempfile\n" if $Debug;

    return $tempfile if (! -e $tempfile || ! $opt{UNIQUE});
    
    my $i = 0;
    while (-e ($tempfile = "${tempfilebase}_${i}${ext}")) { $i++ };

    print "Temp filename (final): $tempfile\n" if $Debug;

    return $tempfile;
}

sub CoM {
    my $vol = shift;

    my $cmd = "mincstats -com -world_only -quiet $vol";
    print "$cmd\n" if $Verbose;
    my $com = `$cmd`;
    die $! if $?;

    return split(/\s+/, $com);
}

# Usage stuff
__END__

=head1 NAME

	create_verify_image - creates a row-based verification image where each column is a slice from an input image, optionally overlayed with other volumes, surfaces, or masks


=head1 SYNOPSIS

	create_verify_image <out.{rgb|jpg|tif|...}> [<in.mnc> ...] [options]

=head1 OPTIONS

=over 8

=item B<-help>

	Print summary of command-line options and exit.

=item B<-clobber>

	Overwrite an existing file.

=item B<-noclobber>

	Don't overwrite an existing file (default).

=item B<-verbose>

	Be verbose.

=item B<-quiet>

	Do not print out progress information.

=item B<-debug>

	Print out debugging information.

=item B<-background_color>

	the `white space' color [default: black]

=item B<-bounding_object>

	the bounding object to use for clipping

=item B<-row>

	specify a row of the verification image (see ROW SPECIFICATIONS)

=item B<-align_com>

	align input image origin to its CoM

=item B<-noalign_com>

	opposite of -align_com [default]

=item B<-cols>

	comma-separated list of column view specifications. Specifications start with a character indicating the plane to view ('t' for transverse, 's' for sagittal, 'c' for coronal) followed by slice (world) coordinates. Slice coordinates are specifies as <start>:<stop>:<step>. Start  and  stop  can  be  left  blank  to slice  to  volume  extremes.  Blank  step  defaults  to  1  [default: t-35,t10,t65,s-30,s60,c-90,c-25,c30]

=item B<-autocols>

	automatically add <nslices> regularly spaced slices in each direction. These slices are added to any columns specified via -cols [default: 0]

=item B<-autocol_planes>

	comma-separated list of planes used by -autocols. (example: 's,c') [default: s,c,t]

=item B<-height>

	height of the output image [default: 0]

=item B<-width>

	width of the output inpage [default: 0]

=item B<-filetitle>

	add the filename as a title to each row which does not have an explicit title

=item B<-nofiletitle>

	opposite of -filetitle [default]

=item B<-repeattitle>

	repeat titles across their entire row

=item B<-norepeattitle>

	opposite of -repeattitle [default]

=item B<-transpose>

	transpose the image matrix. Note that -width and -height always apply to the final output image, i.e., after the transpose operation if specified

=item B<-notranspose>

	opposite of -transpose [default]

=back

=head1 ROW SPECIFICATION

The B<-row> arguments can specify a base volume, its color map, its title, and any overlays. Multiple rows should be specified using multiple -row options.  If no <row.mnc> is specified, input volumes are taken from the global <in.mnc> list.

For example, the following specification would render slices of volume.mnc overlaid by mask.mnc:

      -row volume.mnc overlay:mask.mnc

A row can have any number of overlay specifications

      -row volume.mnc overlay:mask.mnc overlay:surface

Four-dimensional columes can be exploded with a "explode" tag:

      -row explode:volume.mnc
      -row explode-time:volume.mnc

COLOR

B<color:<color_mapE<gt>:<minE<gt>:<maxE<gt>>

B<color:<color_mapE<gt>:<mask.mncE<gt>:<bin_valueE<gt>>

Everything after <color_map> is optional.

The color specification determines the color space in which to render the volume for this row. Available color_map values are:

    hot
    gray
    spect
    label

If min/max and mask.mnc/bin_value are left out, intensity range is automatically computed over each volume.

Min and max can be explicitly set

       color:gray:0:100

or can be defined as a percent of the automatically computed range

       color:gray:50%:150%

If a mask is specified the intensity range is calculated under just that region (voxels within 0.5 of <bin_value> (default: 1) are included from the mask volume)

       color:gray:mask.mnc

TITLE

B<title:<string>>

The title specification determines the title for this row.

OVERLAY

B<volume_overlay:<volume.mncE<gt>:<opacityE<gt>:<colorsE<gt>>

B<surface_overlay:<surface.objE<gt>:<colorE<gt>:<thicknessE<gt>>

Everything after <volume.mnc> and <surface.obj> is optional.

Overlay specification can be done with "overlay:". In this case, whether the overlay is a volume overlay or a surface overlay is determined by file extension.

Volume overlays render a semi-transparent volume in some color space. Opacity should be a number between 0 and 1. Colors can be either a pre-existing color map (hot, gray, spect), a path to a custom color map, or an in-line color map.

An  in-line  color  map is specified in comma-separated "label:color" pairs. The following specification would overlay volume.mnc with opacity=0.5 and the labels 1, 2, and 3 mapped to red, green, and blue, respectively:

       volume_overlay:volume.mnc:0.5:1:red,2:green,3:blue

Volumes can be binarized with a "B[<min>,<max>]" specification. The following specification would threshold the volume from 0.5 to 5.5 and overlay the result in red:

       volume_overlay:volume.mnc:0.5:B[0.5,5.5]:red

Surface overlays render a surface in some solid color. The thickness of the line is automatically determined, but can be set explicitly (see ray_trace) or scaled (x<scale>). If a volume is given to a surface overlay, a surface is generated using marching_cubes.

       surface_overlay:surface.obj:green:x1.2
       surface_overlay:volume.mnc:green:x1.2

=head1 EXAMPLES

A two-row verification image, with one line containing just a volume, and the next line overlaid with a volume and a suface:

       create_verify_image out.png -width 1600 -autcols 3 -row volume.mnc color:gray -row volume.mnc overlay:surface.obj:green overlay:volume.mnc:0.3:1:red,68:yellow

=cut
