#! /usr/bin/perl -w

# mritotal (new and improved)
# 
# All-new version of Louis Collins' mritotal script.  Embodies pretty
# much the same algorithm, but rewritten almost entirely from scratch
# by Greg Ward, August 1995.  The changes to the algorithm are:
#   * volume is subsampled before any blurring takes place (old version
#     blurred to 2mm, then subsampled, then blurred to 8mm and 16mm --
#     this is more correct, but very memory intensive)
#   * volume may be cropped at the same time as it's subsampled
#     (this is very data-specific -- for ICBM data, we crop off 25%
#     of the data at the low z, ie. at the bottom of the head
#   * volume is zero-padded before blurring instead of cropped after
#     blurring
#   * COG of source volume is computed only once (by a separate program,
#     volume_cog) rather than by a PAT on every fitting step; in fact,
#     the PAT is only used once, to estimate the translations of the first
#     fit step
#
# The changes to the user interface are extensive.  Most importantly,
# you can specify which preprocessing steps to take using either
# a protocol file or with command-line overrides.  See the man
# page for full details.
#
# Here is Louis' original copyright notice
# (with a slight revision ;-):
#

# --------------------------------------------------------------------
# Copyright (c) 1993-97 Louis Collins and Greg Ward, 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.
#
# Developed by Louis Collins under the direction of Dr. Alan Evans and
# Dr. Terry Peters at the NeuroImaging Laboratory at the Montreal
# Neurological Institute.
#
# Note that the programs mincinfo and mincresample are written &
# copyrighted by Peter Neelin, McConnell Brain Imaging Centre, with
# the same copyright as above.
# --------------------------------------------------------------------

# $Id: mritotal.in,v 1.12 2004/02/12 05:55:18 rotor Exp $

require 5.001;

use FindBin;
use lib "$FindBin::Bin/../lib/mni_autoreg";

use Startup;
use Getopt::Tabular qw/GetOptions SpoofGetOptions/;
use JobControl qw/AddProgramOptions Spawn/;

require "file_utilities.pl";
require "path_utilities.pl";
require "numeric_utilities.pl";
require "minc_utilities.pl";
require "volume_heuristics.pl";

# This "use vars" statement is useful for checking the strictness of the
# initialization functions -- normally, they live under a "no strict"
# pragma, and hence no global variable checking is done in them.  To check
# them, un-comment this "use vars", change the "no strict" to a "use
# strict", and try to compile the script.  The reason that we keep the "use
# vars" commented out most of the time is because it's dangerous -- a "use
# vars" applies to the entire file, and it can't be countermanded.  Thus,
# we would be able to refer accidentally to any of these global variables
# in the latter part of the script, which always lives under "use strict",
# with no globals at all allowed.  This lets us keep a lid on the
# proliferation of global variables in the initialization subroutines
# without completely disallowing them (this would be hard, given the way
# the script was originally written).  Unfortunately, it means we
# periodically have to go through the change-this-bit-and-recompile
# silliness.  Sigh.

use vars qw($ModelDir $Model $Protocol
            @NonspecialLevels @SpecialLevels @Levels
            $NonlinearFit $StartLevel $StopLevel $StartIndex $StopIndex 
            $GuessSubsample @Subsample $GuessCrop
            @Crop $Objective $FirstObj
            $InputXfm @Blurs @BlurModes $Blur $OldPad
            $Help $Usage $Version $LongVersion
            @ConfigPath $ProtocolTbl $SiteTbl $SourceVol $FinalXfm
            $Clamp $ClampFactor
            $VolumeCOG $SourceBase);

use strict;                              # for badly-behaved main program
                                        # and initialization code
# no strict;

# ----------------------------------------------------------------------
# BEGIN main program

{
   my (@linear_fits, @nonlinear_fits, @fits);
   my ($do_linear, $linear_xfm, $nl_input_xfm);

   &Startup;			# from Startup module - general startup stuff
   &Initialize;			# sets globals, parses command line args

   # Quit now if the output transform exists and $Clobber is false

   if (-e $FinalXfm && ! $Clobber)
   {
      &Fatal ("$FinalXfm exists -- use -clobber to overwrite it");
   }


   # If we're to do non-linear fitting, setup the list of fit profiles
   # describing the desired levels of non-linear fits.  Also figure out
   # if we're going to be doing the linear fit, and what the initial transform
   # for the non-linear fits will be.

   if ($NonlinearFit)                   # user wants us to do nonlinear fit?
   {
      $linear_xfm = "$TmpDir/${SourceBase}_final_lin.xfm";

      if (defined $InputXfm)            # user-supplied xfm means skip linear
      {
         $do_linear = 0;
         $nl_input_xfm = $InputXfm;
      }
      else                              # no input xfm -- will start with 
      {                                 # first linear fit
         $do_linear = 1;
         $nl_input_xfm = $linear_xfm;
      }

      @nonlinear_fits = &SetupNLFits ($StartIndex, $StopIndex,
                                      $nl_input_xfm, $FinalXfm, $Objective);
   }
   else                                 # just do linear fits
   {
      $do_linear = 1;
      $linear_xfm = $FinalXfm;
   }


   # Reduce (subsample/crop), pad, blur, and unpad the input volume.
   # (Oh yeah, also maybe compute the COG of the pre-blurred data.)  We
   # skip this entirely if we're doing only nonlinear fits that rely on
   # "special preprocessing", which starts over with the original
   # untouched native data

   if ($do_linear ||
       ($NonlinearFit && 
        grep ($StartLevel eq $_, @NonspecialLevels)))
   {
      $VolumeCOG = &Preprocess 
         ($SourceVol, $SourceBase, $do_linear,
          $GuessSubsample, \@Subsample, $GuessCrop, \@Crop,
          $Blur, \@Blurs, \@BlurModes, $OldPad, $InputXfm);
   }


   # Now that we know if we're going to do the linear fits, setup
   # the list of fit profiles for them.

   if ($do_linear)
   {
      @linear_fits = &SetupFits (\@Blurs, $Blur, $VolumeCOG,
                                 $linear_xfm, $InputXfm,
                                 $Objective, $FirstObj);
   }


   die "whoops! no fits to do!" unless @nonlinear_fits || @linear_fits;


   # And do the actual fitting - we only pass in the base of the source
   # filename, because &PerformFits depends on &GradientBlur having
   # put the blur files in $TmpDir according to specific naming conventions
   # (see &GradientBlur).

   &PerformFits ([@linear_fits, @nonlinear_fits],
                 $SourceVol, $SourceBase, $Model);

   &Cleanup (1);

}

# END main program
# ----------------------------------------------------------------------


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &CreateInfoText
#@INPUT      : none
#@OUTPUT     : none
#@RETURNS    : nothing
#@DESCRIPTION: Sets the $Help, $Usage, $Version, and $LongVersion globals,
#              and registers the first two with ParseArgs so that user gets
#              useful error and help messages.
#@METHOD     : 
#@GLOBALS    : $Help, $Usage, $Version, $LongVersion
#@CALLS      : 
#@CREATED    : 95/08/25, Greg Ward (from code formerly in &ParseArgs)
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub CreateInfoText
{
   $Version = "0.98r";
   $LongVersion = "Package MNI AutoReg, version 0.98r, compiled by nicks\@minerva (x86_64-unknown-linux-gnu) on 2010-02-20 at 17:33:24";

   $Usage = <<USAGE;
$ProgramName, version $Version

Usage: $ProgramName [options] input_volume output_transform
       $ProgramName -help
USAGE

   $Help = <<HELP;
$ProgramName registers a single T1-weighted MRI volume to Talairach
space by fitting successively less-blurred versions of the input
volume to similarly blurred versions of a pre-existing model.  (The
default model is the MNI 305 average brain.)  Currently, the sequence
of resamplings, blurs, crops and fits carried out by $ProgramName is
hard-coded, so you'll have to edit the source if you don't like it.

You can specify an input transformation (using the -transformation
option) to start off with; if you do this, then $ProgramName will skip
the first couple of fits and use your initial guess in place of them.
(In particular, it starts at a 9-parameter, gradient fit of $Blurs[0]
mm blurred data; normally, it starts with a 7-parameter intensity fit
of $Blurs[1] mm blurred data.)
HELP

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

# ------------------------------ MNI Header ----------------------------------
#@NAME       : &SetupArgTables
#@INPUT      : none
#@OUTPUT     : none
#@RETURNS    : References to the four option tables:
#                @site_args
#                @pref_args
#                @protocol_args
#                @other_args
#@DESCRIPTION: Defines the tables of command line (and config file) 
#              options that we pass to ParseArgs.  There are four
#              separate groups of options, because not all of them
#              are valid in all places.  See comments in the routine
#              for details.
#@METHOD     : 
#@GLOBALS    : makes references to many globals (almost all of 'em in fact)
#              even though most of them won't have been defined when
#              this is called
#@CALLS      : 
#@CREATED    : 95/08/23, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub SetupArgTables
{
   my ($ok_levels) = @_;
   my (@default_args, @pref_args, @site_args, @protocol_args, @other_args);

   sub print_version
   {
      print "Program $ProgramName, built from:\n$LongVersion\n";
      exit;
   }

   # Table entries: an array ref per option; the array entries are 
   # as follows:
   #   name
   #   type 
   #   num_values
   #   option_data
   #   help_string (optional)
   #   arg_desc (optional)

   # Default args -- the defaults from Startup.pm, plus "-version"

   @default_args =
      (@DefaultArgs,
       ["-version", "call", undef, \&print_version,
        "print version and quit"]);

   # Site-specific options -- these may be given in the configuration file
   # or the command line

   @site_args = 
      (["Site-specific options (location of models, preprocessing protocol)",
        "section"],
       ["-modeldir", "string", 1, \$ModelDir,
	"set the default directory to search for model files"],
       ["-model", "string", 1, \$Model,
	"set the base name of the fit model files"],
       ["-protocol", "call", 1, \&ReadProtocol,
	"set the protocol, which controls the preprocessing options " .
	"via a protocol file"]);


   # Protocol (data-specific) options -- these may be given in the 
   # protocol file or on the command line

   sub set_pp_option
   {
      my ($option, $arglist, $status, $list, $guess) = @_;

      if ($status eq "none")
      {
         @$list = (0);
         $$guess = 0;
      }
      elsif ($status eq "guess")
      {
         @$list = (0);
         $$guess = 1;
      }
      else
      {
         warn "set_pp_option: unknown status $status\n";
         return 0;
      }
      return 1;
   }

   @protocol_args = 
      (["Fit type and fitting control", "section"],

       ["-nonlinear|-linear", "boolean", 0, \$NonlinearFit,
        "perform a nonlinear fit [default: -linear]"],
       ["-startlevel", "string", 1, \$StartLevel,
        "where to start the nonlinear fitting ($ok_levels)"],
       ["-stoplevel", "string", 1, \$StopLevel,
        "where to stop the nonlinear fitting ($ok_levels)"],

       ["-objective", "string", 1, \$Objective,
	"objective function to use for fitting"],
       ["-firstobj", "string", 1, \$FirstObj,
        "objective function to use for first fit only"],

       ["Preprocessing, part 1: subsample", "section"],
       ["-guess_subsample", "call",
        ["guess", \@Subsample, \$GuessSubsample], \&set_pp_option,
	"make an educated guess about step sizes for subsampling [default]"],
       ["-subsample", "float", 3, \@Subsample,
	"voxel step sizes (x,y,z) to use when subsampling volume"],
       ["-isosubsample", "float", 1, \$Subsample[0],
	"voxel step size (applied isotropically) to use when " .
	"subsampling volume"],
       ["-nosubsample", "call", 
        ["none", \@Subsample, \$GuessSubsample], \&set_pp_option,
	"disable volume subsampling"],

       ["Preprocessing, part 2: crop", "section"],
       ["-guess_crop", "call", ["guess", \@Crop, \$GuessCrop], \&set_pp_option,
	"make an educated guess about how to crop the volume [default]"],
       ["-crop", "string", 3, \@Crop,
	"specify crop amounts for the three spatial dimensions"],
       ["-isocrop", "string", 1, \$Crop[0],
	"specify a single crop amount (applied equally to all three spatial " .
	"dimensions)"],
       ["-nocrop", "call", ["none", \@Crop, \$GuessCrop], \&set_pp_option,
	"disable cropping"],

       ["Preprocessing, part 3: clamp (OBSOLETE)", "section"],
       ["-clamp", "boolean", 0, \$Clamp,
        "clamp data to remove excessively bright voxels [default: -noclamp]"],
       ["-clampfactor", "float", 1, \$ClampFactor,
        "how far above (number of sd's) volume median to clamp data"],

       ["Preprocessing, part 4: pad/blur", "section"],
       ["-blur", "boolean", 0, \$Blur,
        "blur the data before fitting [default; opposite is -noblur]"],
       ["-oldpad|-newpad", "boolean", 0, \$OldPad,
        "unpad data in the old (incorrect) way, i.e. don't encroach " .
        "original volume [default: false]"]);


   # Other options -- these may *only* be given on the command line

   @other_args = 
      (["Other options", "section"],
       ["-transformation", "string", 1, \$InputXfm,
	"specify the starting transformation to use"]);

   &Getopt::Tabular::SetSpoofCodes 
      (-version         => \&print_version,
       -protocol        => sub { &ReadProtocol (@_, 1); },
       -guess_subsample => sub { 1 },
       -nosubsample     => sub { 1 },
       -guess_crop      => sub { 1 },
       -nocrop          => sub { 1 });

   (\@default_args, \@site_args, \@protocol_args, \@other_args);
}



# ------------------------------ MNI Header ----------------------------------
#@NAME       : &CheckClampOptions
#@INPUT      : $where - description of what argument source we've just parsed
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Checks to see if $Clamp or $ClampFactor are defined (ie.
#              if any of the clamping options were present in a config
#              or protocol file or on the command line), and warns of 
#              their obsolescense if so.  Also undef's the two variables
#              so that further argument parsing is checked independently.
#@METHOD     : 
#@GLOBALS    : $Clamp, $ClampFactor
#@CALLS      : 
#@CREATED    : 1997/01/18, GPW
#@MODIFIED   : 
#@COMMENTS   : this should eventually disappear, along with the vestigial
#              clamping options it warns about
#-----------------------------------------------------------------------------
sub CheckClampOptions
{
   my ($where) = @_;

   if (defined $Clamp || defined $ClampFactor)
   {
      warn "$ProgramName: warning from $where: -clamp, -noclamp, and " .
           "-clampfactor options are obsolete and ignored\n";
      undef $Clamp;
      undef $ClampFactor;
   }
}



# ------------------------------ MNI Header ----------------------------------
#@NAME       : &ReadConfigFile
#@INPUT      : $path - reference to list of directories to search
#              $file - name of file to search for
#@OUTPUT     : 
#@RETURNS    : $file - full path to $file as found in one of the directories
#                      in $path
#              @args - the list of words found in the file, after removing 
#                      comments and blank lines and applying shell quoting
#                      rules
#@DESCRIPTION: Reads a configuration file according to the following rules:
#                * anything from # to newline is ignored
#                * blank lines are ignored
#                * lines are split into words according to shell
#                  quoting conventions
#              Returns an array of the entire file split into words.
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/08/23, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub ReadConfigFile 
{
   use strict;                          # at least we have one well-behaved
                                        # init function... ;-)
   my ($path, $file) = @_;
   my ($dir, $args, @args);
   require "shellwords.pl";

   $dir = &SearchDirectories ($file, @$path)
      || &Fatal ("Couldn't find configuration file $file anywhere in " .
		 join (":", @$path));
   $file = $dir . $file;

   open (FILE, $file) || die "Unable to read file $file: $!\n";
   while (<FILE>)
   {
      s/\#.*$//;		# strip comments
      next if /^\s*$/;		# skip blank lines
      push (@args, &shellwords ($_));
   }
   close (FILE);
   ($file, @args);
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &ReadProtocol
#@INPUT      : $option - the command-line option that triggered this call
#              $args   - reference to list of all arguments on command line
#                        following (*not* including) $option
#              $spoof  - set to true to not actually read the file
#                        (ie. no side effects)
#@OUTPUT     : 
#@RETURNS    : 0 if any error in protocol file; 1 otherwise
#@DESCRIPTION: Reads a protocol file based on the -protocol command
#              line option (this routine is a callback from 
#              &ParseArgs -- see the entry for "-protocol" in the 
#              argument table above).
#@METHOD     : 
#@GLOBALS    : sets $Protocol
#              reads @ConfigPath, $ProtocolTbl
#@CALLS      : 
#@CREATED    : 95/08/25, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub ReadProtocol
{
   my ($option, $args, $spoof) = @_;
   my ($protocol_file, @protocol_args);
   $Protocol = shift @$args;

   unless ($Protocol)
   {
      warn "$ProgramName: error: " .
           "$option option must be followed by a protocol name\n";
      return 0;
   }

   return 1 if $spoof;

   # Load the protocol file

   $protocol_file = "mritotal.${Protocol}.cfg";
   ($protocol_file, @protocol_args) = 
      &ReadConfigFile (\@ConfigPath, $protocol_file);
   &verbose ("Loading protocol $Protocol (protocol file = $protocol_file)");

   my ($tbl);
   @$tbl = (@$ProtocolTbl, @$SiteTbl) ;

   unless (&GetOptions ($tbl, \@protocol_args))
   {
      warn "$ProgramName: error in protocol file $protocol_file\n";
      return 0;
   }

   &CheckClampOptions ("protocol file $protocol_file");

   if (@protocol_args)
   {
      warn "$ProgramName: error: found leftover arguments in protocol file " .
           "$protocol_file\n";
      return 0;
   }
   1;
}



# ------------------------------ MNI Header ----------------------------------
#@NAME       : &Initialize
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Sets global variables from configuration file, parses 
#              command line, parses protocol file for more global variables,
#              finds required programs, and sets their options.  Dies on
#              any error.
#@METHOD     : 
#@GLOBALS    : site-specific: $ModelDir, $Model, $Protocol
#              preferences: $Verbose, $Execute, $Clobber, $Debug, $KeepTmp
#              protocol (data-specific preprocessing): @Subsample, @Crop,
#                 $Objective, @Blurs, $Blur
#              $ProtocolArgs
#@CALLS      : &JobControl::SetOptions
#              &JobControl::AddProgramOptions      
#              &SetupArgTables
#              &ReadConfigFile
#              &GetOptions
#              &ReadProtocol (indirectly through ParseArgs)
#              
#@CREATED    : 
#@MODIFIED   : incessantly
#-----------------------------------------------------------------------------
sub Initialize
{
   my ($config_file, @config_args, $protocol_file);
   my ($site_tbl, $pref_tbl, $protocol_tbl, $other_tbl);
   my (@all_args, @newARGV);

   $, = ' ';     # set output field separator

   # First, announce ourselves to stdout (for ease in later dissection
   # of log files) -- unless STDOUT is a tty.

   &SelfAnnounce ("STDOUT") if $Verbose && ! -t "STDOUT";

   # Set defaults for the global variables.  These can be overridden by 
   # the configuration file or the command line.

   $ModelDir     = "$FindBin::Bin/../share/mni_autoreg";
   $Model        = "average_305";
   $Protocol     = "default";

   $Verbose      = 1;
   $Execute      = 1;
   $Clobber      = 0;
   $Debug        = 0;
   $KeepTmp      = 0;

   # Specify the default pre-processing sequence -- these can be
   # overridden by the protocol file or the command line.  (The
   # protocol can in turn be specified either in the configuration
   # file or the on the command line.)

   $GuessSubsample = 1;		# take a guess about subsample step size
   @Subsample    = (0);
   $GuessCrop    = 1;		# and take a guess about cropping too
   @Crop         = (0);
   $Objective    = "xcorr";	# use cross-correlation objective function
   $FirstObj     = "";          # use default objective for first fit

   $NonlinearFit = ($ProgramName eq 'nlfit');
   $StartLevel   = undef;       # so we can detect when they're supplied
   $StopLevel    = undef;
   $InputXfm     = undef;

   @Blurs = (8, 16);
   @BlurModes = qw(gi i);       # 8mm gradient+intensity, 16mm intensity only
   $Blur = 1;
   $OldPad = 0;

   @NonspecialLevels = qw(16 8);
   @SpecialLevels = qw(4a 4b 2);        # levels that require "special 
                                        # preprocessing"
   @Levels = (@NonspecialLevels, @SpecialLevels);
   my $ok_levels = join (', ', @Levels[0 .. ($#Levels-1)]) . ', or ' . $Levels[-1];

   &CreateInfoText;

   @ConfigPath = ($ENV{"HOME"}, "$FindBin::Bin/../etc/mni_autoreg");
   ($pref_tbl, $site_tbl, $protocol_tbl, $other_tbl) = 
      &SetupArgTables ($ok_levels);
   @all_args = (@$pref_tbl, @$site_tbl, @$protocol_tbl, @$other_tbl);
   $ProtocolTbl = $protocol_tbl; # global so &ReadProtocol can see it
   $SiteTbl     = $site_tbl;     # global so &ReadProtocol can see it


   # Make a first pass over the command line -- this doesn't actually do
   # anything; it just checks for correctness.  That way, if the user asks
   # for help or makes a silly mistake, they don't have to wait for the
   # config and protocol files to all be loaded and parsed before getting
   # help text or an error message.  (Also, it ensures that errors
   # resulting from the config or protocol files will be reported *after*
   # command line errors, which I deem to be a good thing.)

   &SpoofGetOptions (\@all_args, \@ARGV, \@newARGV)
      || exit 1;
   if (@newARGV != 2)
   {
      warn $Usage;
      die "Incorrect number of arguments\n";
   }
   &CheckClampOptions ("command line");


   # Load the configuration file that sets site-specific options and
   # preferences.  Note that since $Protocol is a site-specific
   # option, it will be found in the config file, which will cause the
   # protocol file to be immediately read.  Then, if the user selects
   # another protocol on the command line, *that* protocol file will
   # be read to override the settings from the default protocol file.
   # Finally, the user can override specific data-specific options on
   # the command line as long as he does so *after* any -protocol
   # option.

   $config_file = "mritotal.cfg";
   ($config_file, @config_args) = 
      &ReadConfigFile (\@ConfigPath, $config_file);
   &verbose ("Loading configuration file $config_file");
   &GetOptions ([@$site_tbl, @$pref_tbl], \@config_args)
      || &Fatal ("Error in configuration file $config_file");
   &Fatal ("Found leftover arguments in config file $config_file\n")
      if (@config_args);
   &CheckClampOptions ("configuration file $config_file");


   # Now parse the actual command-line options (as opposed to options
   # in the configuration or protocol file).  Again, note that if the
   # user specifies a -protocol option here then that protocol file
   # will be *immediately* loaded (via &ReadProtocol, which is a
   # callback from &GetOptions).  Then, other data-specific
   # options (-subsample, -crop, etc.) can be used to override the
   # settings in that protocol file.

   &GetOptions (\@all_args, \@ARGV, \@newARGV) || 
      die "Unexpected error in second pass over command line arguments";
   die "Expected only two leftover args after second pass over " .
       "command line arguments"
          unless @newARGV == 2;
   ($SourceVol, $FinalXfm) = @newARGV;


   # Find all the required subprograms -- everything should be on
   # the $PATH already, else we're in for a hard time portability-wise

   my @programs = qw/mincresample
                     mincblur
                     volume_cog
                     minctracc
                     check_scale
                     autocrop/;
   push (@programs, 'xfmtool')
      if $NonlinearFit;

   &JobControl::SetOptions (ErrorAction => 'fatal',
                            Verbose     => $Verbose,
                            Execute     => $Execute,
                            Strict      => 1);
   &JobControl::FindPrograms (\@programs) || exit 1;


   # Add -debug, -quiet, -clobber to subprogram command lines 
   # as appropriate
   
   AddProgramOptions ([qw(mincblur minctracc mincresample autocrop)], 
                      ["-quiet"])
      unless $Verbose;
   AddProgramOptions ([qw(mincblur minctracc mincresample autocrop)],
                      ["-clobber"])
      if $Clobber;
   AddProgramOptions ([qw(mincblur minctracc)], ["-debug"])
      if $Debug;

   # Turn off GuessSubsample/GuessCrop if any subsample/crop
   # array other than (0) is specified -- this is what lets
   # us override guessing by simply specifying "-subsample ..."
   # on the command line.
   
   $GuessSubsample = 0 unless (@Subsample == 1 && $Subsample[0] == 0);
   $GuessCrop = 0 unless (@Crop == 1 && $Crop[0] == 0);


   &check_output_dirs ($TmpDir) if $Execute;

   # Make sure that $Model has path + basename (by appending $ModelDir
   # if necessary), and then check for the existence of the required
   # model files.

   $ModelDir .= "/" if ($ModelDir ne "" && $ModelDir !~ m|/$|);
   $Model = $ModelDir . $Model unless $Model =~ m|^/|;

   my (@model_files) = ('16_blur', '8_blur', '8_dxyz', '16_mask', '8_mask', 'headmask');
   @model_files = map { "${Model}_${_}.mnc" } @model_files;
      
   &check_files ($SourceVol, @model_files) || &Fatal;
   $SourceBase = (&split_path ($SourceVol))[1];


   # Check the nonlinear fitting stuff

   if ($NonlinearFit)
   {
      $StartLevel = '16' unless defined $StartLevel;
      $StopLevel = '8' unless defined $StopLevel;

      my $i;
      for ($i = 0; $i < @Levels; $i++)
      {
         $StartIndex = $i if $Levels[$i] eq $StartLevel;
         $StopIndex = $i if $Levels[$i] eq $StopLevel;
      }

      die "-start_level must be $ok_levels\n"
         unless defined $StartIndex;
      die "-stop_level must be $ok_levels\n"
         unless defined $StopIndex;

      die "-startlevel may not be less than -stoplevel\n"
         unless $StartIndex <= $StopIndex;
   }
   else
   {
      warn "$ProgramName: warning: " .
           "-startlevel and -stoplevel ignored unless -nonlinear given\n"
         if defined $StartLevel || defined $StopLevel;
   }


   # Now dump out a summary of the options

   &verbose("   source = $SourceVol");
   &verbose("    model = $Model");
   &verbose("transform = $FinalXfm");

   my (%obj_desc) = ("xcorr"  => "cross-correlation",
		     "zscore" => "normalized difference",
		     "ssc"    => "stochastic sign change",
		     "vr"     => "variance of ratios",
		     "mi"     => "mutual information",
		     "optic"  => "optical flow");

   &verbose(" protocol = $Protocol:");
   my $fit_desc = 
      ($NonlinearFit
       ? "nonlinear fit from level $StartLevel to $StopLevel"
       : "linear fit only");
   my ($subsample_desc) = 
      ($Subsample[0]
       ? "subsample to " . join(",", @Subsample) . "mm"
       : ($GuessSubsample ? "subsample heuristically" : "do not subsample"));
   my ($crop_desc) = 
      ($Crop[0]
       ? "crop according to @Crop"
       : ($GuessCrop ? "crop heuristically" : "do not crop"));
   my ($blur_desc) = 
      ($Blur
       ? "blur with $Blurs[1] and $Blurs[0] mm FHWM kernels"
       : "do not blur");
   my ($pad_desc) = 
      ($OldPad
       ? "pad/unpad the old way (don't encroach on original volume)"
       : "pad/unpad correctly (encroach on original volume)");
   my (@protocol_desc) = 
      ($fit_desc,
       $subsample_desc,
       $crop_desc,
       $blur_desc,
       $pad_desc,
       ("default objective function = " . 
        ($obj_desc{$Objective} || "UNKNOWN")));
   push (@protocol_desc, 
         "objective function for first fit = " .
         ($obj_desc{$FirstObj} || "UNKNOWN")) 
      if $FirstObj;
   &verbose("    " . join ("\n    ", @protocol_desc));
}

# ======================================================================
# END INITIALIZATION CODE
# ======================================================================

# ----------------------------------------------------------------------
# Now we begin the actual processing code.  Apart from the obvious
# difference in purpose, note that the initialization routines above
# are ruthlessly non-strict -- they read and write a wide variety of
# global variables without a care in the world.  From this point on,
# though, the code is much better behaved.
# ----------------------------------------------------------------------

use strict;

# ------------------------------ MNI Header ----------------------------------
#@NAME       : &Preprocess
#@INPUT      : $volume - full name of input volume
#              $base   - base name (no directory) of input volume
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Subsamples, finds the volume centroid, and blurs.
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/08/04, Greg Ward (from code in main program)
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub Preprocess
{
   die "&Preprocess: incorrect number of arguments" unless @_ == 12;
   my ($volume, $base, $compute_cog,
       $guess_subsample, $subsample, $guess_crop, $crop,
       $blur, $blur_fwhm, $blur_modes, $old_pad, $input_xfm) = @_;

   my ($reduced, $padded, @starts, @steps, @lengths);
   my ($volume_cog);                    # return value!
   
   # If the user asked us to guess_ the subsample step sizes and
   # crop amounts, guess away and ignore whatever's in @$subsample
   # and @$crop.

   &volume_params ($volume, \@starts, \@steps, \@lengths);
   if ($guess_subsample || $guess_crop)
   {
      @$subsample = &GuessSubsample (\@steps)
	 if ($guess_subsample);
      @$crop = &GuessCrop (\@steps, \@lengths)
	 if ($guess_crop);
   }


   # Reduce the input volume to save time and memory; the reduction
   # consists of sub-sampling to a given step size (@$subsample),
   # and chopping off chunks of the volume (as specified by the elements
   # of the @$crop array - these are autocrop-style extension pairs,
   # and there should be either one (to crop isotropically) or three
   # (to crop the three dimensions separately) of them.

   $reduced = &ReduceVolume ($volume, $base, "crop", $subsample, $crop);


   # Find the COG of the input volume -- well, of the input volume after
   # reduction.  We do it before padding because padding doesn't affect the
   # COG but would make volume_cog take a little longer, and before
   # blurring because blurring definitely does affect the COG.  (Hopefully
   # subsampling doesn't affect it too much!)

   if ($compute_cog)
   {
      $volume_cog = &volume_cog ($reduced);
      &verbose ("Centroid of input volume: $volume_cog");
   }

   # If blurring is to be done, then zero-pad and do it.  Otherwise, make
   # the reduced volume a symlink to just "base.mnc" -- and note that, in
   # &SetupFits, we make appropriate modifications to the fit profiles to
   # look for "base.mnc" instead of "base_nn_{blur,dxyz}.mnc"!

   if ($blur)
   {
      if ($input_xfm)
      {
         pop @$blur_fwhm;               # skip 16mm blur
         pop @$blur_modes;

         # Commenting this line out introduces a tiny bit of wastage for
         # manually seeded linear fits: we will crop and keep around the
         # intensity blur, even though it's not needed.  It is needed
         # when we graduate to nonlinear fitting, though, so selecting
         # between 'gi' and 'g' here would be a bit tricky.  Some other
         # time, perhaps.
#        $blur_modes->[0] = 'g';        # and 8mm blur becomes gradient only
      }

      my $steps = (@$subsample == 3) ? $subsample : \@steps;
      PadBlur ($reduced, $base, $steps, $old_pad, $blur_fwhm, $blur_modes);
   }
   else
   {
      # This is done by an external program instead of Perl's symlink
      # so that it will show up clearly in log files.  Also note that
      # we strip the directory from the `source' file because the link
      # will be in the same directory, and "ln -s" doesn't work *quite* 
      # the same as "cp" in this respect... *sigh*...

      &verbose ("\nSkipping blurring step");
      my $reduced_nodir = &replace_dir ("", $reduced);
      &Spawn ("/bin/ln -s ${reduced_nodir} ${TmpDir}/${base}.mnc");
   }

   return $volume_cog;
}  # &Preprocess


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &pad_amounts
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Computes the amounts to pad and unpad by for a given
#              set of blurring kernels and a particular list of step sizes.
#@METHOD     : 
#@CALLERS    : &PadBlur, &special_pp
#@CALLS      : 
#@CREATED    : 1997/09/12, GPW (extracted from &PadBlur)
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub pad_amounts
{
   my ($blur_fwhm, $steps, $old_pad) = @_;
   my ($pad, @pad, @unpad);

   # Figure out how much we need to pad by.  There's one set of three
   # numbers (x,y,z padding) for *all* blurring kernels; we pad enough
   # for the largest kernel.  That's overkill for the smaller ones, but
   # harmless.  (And I'm guessing that it's faster to blur an overpadded
   # volume than to make multiple copies padded by different amounts.)
   # Thus, @pad will just be a list of three numbers.

   $pad = max (@$blur_fwhm) * 3 / (sqrt (8 * log(2)));
   @pad = map { round ($pad, $_, +1) } @$steps;


   # Figure out how much to "unpad" (crop off) after blurring -- this
   # will be the pad amount plus 3*sigma for each size of blurring
   # kernel.  The extra 3*sigma encroaches on the original volume, so we
   # don't want to blindly cut off the same amount for each blurring
   # size (like we can get away with when padding).  @unpad will be 
   # a list of lists -- one list of three numbers (x,y,z unpadding) for
   # each kernel size.
   
   my $i;
   for $i (0 .. $#$blur_fwhm)
   {
      if ($old_pad)
      {
         $unpad[$i] = [map (-$_, @pad)]; # compatability
      }
      else
      {
         my $encroachment = $blur_fwhm->[$i] * 3 / (sqrt (8 * log(2)));
         $unpad[$i] = 
            [map (- $pad[$_] - round ($encroachment, $steps->[$_], +1), 
                  0..2 )];
      }
   }  # for $i

   (\@pad, \@unpad);
}  # &pad_amounts


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &SelectiveBlur
#@INPUT      : $input
#              $output_base
#              $fwhm
#              $unpad
#              $mode
#@OUTPUT     : (calls one of the blurring functions, so mincblur writes
#              output file based on $output_base and $fwhm)
#@RETURNS    : 
#@DESCRIPTION: Blurs a single MINC file, either gradient, intensity, or
#              both (depending on $mode).
#@METHOD     : 
#@CALLERS    : 
#@CALLS      : 
#@CREATED    : 1997/12/09, GPW & DLC (from code in &PadBlur)
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub SelectiveBlur
{
   my ($input, $output_base, $fwhm, $unpad, $mode) = @_;

   &IntensityBlur ($input, $output_base, $fwhm, $unpad), return
      if $mode eq 'i';
   &GradientBlur ($input, $output_base, $fwhm, $unpad, 1), return
      if $mode eq 'gi';
   &GradientBlur ($input, $output_base, $fwhm, $unpad, 0), return
      if $mode eq 'g';
   die "unknown blur mode \"$mode\"";
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : PadBlur
#@INPUT      : $input      - input file (passed to mincblur)
#              $base       - output basename (also passed to mincblur)
#              $steps      - steps (list ref: x,y,z) of input volume (
#                            used for rounding padding)
#              $old_pad    - flag: if true, will do the old-style, "no
#                            encroachment" unpadding
#              $blur_fwhm  - ref to list of blurring kernel FWHMs
#              $blur_modes - ref to list of strings describing what to
#                            do for each kernel size: 'i' for intensity
#                            blur only, 'g' for gradient only, 'gi' for both
#@OUTPUT     : one or two files (intensity, gradient, or both) per fwhm;
#              filenames will be $base + fwhm + ("blur" | "dxyz") + ".mnc"
#@RETURNS    : 
#@DESCRIPTION: Zero-pads a volume by the maximum amount necessary for a 
#              series of blurs, and carries out the blurs (which individually
#              take care of unpadding the blurred data).
#@METHOD     : 
#@GLOBALS    : 
#@CALLERS    : 
#@CALLS      : pad_amounts, PadVolume, IntensityBlur, GradientBlur
#@CREATED    : 1997/09/04, GPW (from code in &Preprocess)
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub PadBlur
{
   my ($input, $base, $steps, $old_pad, $blur_fwhm, $blur_modes) = @_;
   my ($pad, $unpad, $padded);

   # First zero-pad the volume (by 3 * sigma, where sigma is the SD of the
   # largest gaussian blurring kernel that mincblur will use) to avoid edge
   # effects in the FFT.

   ($pad, $unpad) = &pad_amounts ($blur_fwhm, $steps, $old_pad);
   $padded = &PadVolume ($input, $base, "pad", $pad);


   # Create the blurred volumes from the reduced volume

   my $i;
   for $i (reverse 0 .. $#$blur_fwhm)	# reverse to emulate old behaviour
   {
      &SelectiveBlur ($padded, $base, $blur_fwhm->[$i], $unpad->[$i],
                      $blur_modes->[$i]);
   }

   unlink $padded unless $KeepTmp;
}  # PadBlur


# ----------------------------------------------------------------------------
#    Routines called by &Preprocess:
#       &ReduceVolume
#       &PadBlur
#       &PadVolume
#       &IntensityBlur
#       &GradientBlur
# ----------------------------------------------------------------------------


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &ReduceVolume
#@INPUT      : $input - name of input volume
#              $base  - basename of input volume, without directory
#              $label - string to tack on after basename in output filenames
#              $step  - reference to array of subsample step sizes
#                       (if array has one element, we will subsample
#                       isotropically)
#              $extend- reference to array of extension pairs.  Extension
#                       pairs themselves must be given as comma-delimited
#                       strings (we'll let autocrop parse those).  There
#                       can be either one or three extension pairs; if 
#                       one, it is passed to autocrop with -isoextend;
#                       if three, it is passed with -extend.
#@OUTPUT     : 
#@RETURNS    : Name of output (subsampled and cropped) volume, or name
#              of input volume if data reduction skipped
#@DESCRIPTION: Subsamples and crops the input volume to a given step size 
#              and with a given extension.  The extension is specified
#              autocrop-style, ie. as pairs of extensions given for
#              low and high end of each axis.  If $step is false, the
#              volume is cropped but not subsampled.  If $extend is
#              false, the volume is subsampled but not cropped.  If
#              both are false, &ReduceVolume doesn't do anything.
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/08/02, Greg Ward
#@MODIFIED   : 95/08/21, GW: dropped the $pad option and added $extend
#-----------------------------------------------------------------------------
sub ReduceVolume
{
   die "&ReduceVolume: wrong number of arguments" 
      unless (@_ >= 3 && @_ <= 5);
   my ($input, $base, $label, $step, $extend) = @_;
   my (@step, @extend, $reduced);

   return $input unless $step || $extend;
   $reduced = "${TmpDir}/${base}_${label}.mnc";

   if ($step && $step->[0])
   {
      if (@$step == 1)
      {
	 @step = ("-isostep", $step->[0]);
      }
      elsif (@$step == 3)
      {
	 @step = ("-step", @$step);
      }
      else
      {
	 &Fatal ("\&ReduceVolume: \@\$step must have 1 or 3 elements");
      }
   }
   else
   {
      @step = ();
   }


   # If the user supplied a crop specification (which must be a 1- or 
   # 3-element array pointed to by $extend), then use it; if not, or
   # if $extend points to an empty array, then don't try to crop.

   if ($extend && $extend->[0])
   {
      if (@$extend == 1)
      {
	 @extend = ("-isoextend", $extend->[0]);
      }
      elsif (@$extend == 3)
      {
	 @extend = ("-extend", @$extend);
      }
      else
      {
	 &Fatal ("\&ReduceVolume: \@\$extend must have 1 or 3 elements");
      }
   }
   else
   {
      @extend = ();
   }

   unless ($step || $extend)
   {
      &verbose ("Skipping reduction step");
      return $input;
   }
   
   if (-e $reduced)
   {
      &verbose ("$reduced already exists");
   }
   else
   {
      &verbose ("\nSubsampling/cropping data:");
      &Spawn (["autocrop", $input, $reduced, @step, @extend]);
   }

   $reduced;
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &PadVolume
#@INPUT      : $input - name of input volume
#              $base  - basename of input volume, without directory
#              $label - string to tack on after basename in output filenames
#              $padding - amount of padding to add to volume (must be
#                         a reference to a list of 3 strings: autocrop-
#                         style "extension" specifications for the x, y,
#                         and z axes)
#@OUTPUT     : 
#@RETURNS    : Name of output (padded) volume, or name of input volume
#              if padding skipped
#@DESCRIPTION: Isotropically zero pads a volume by a given amount.
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/08/22, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub PadVolume
{
   die "&PadVolume: wrong number of arguments" unless (@_ == 4);
   my ($input, $base, $label, $padding) = @_;
   my ($pad);

   unless ($padding && @$padding)
   {
      &verbose ("Skipping zero-padding step");
      return ($input);
   }

   $pad = "${TmpDir}/${base}_${label}.mnc";
   if (-e $pad)
   {
      &verbose ("$pad already exists");
   }
   else
   {
      &verbose ("\nZero-padding data:");
      &Spawn (["autocrop", $input, $pad, "-expand", @$padding]);
   }
   return ($pad);
}



# ------------------------------ MNI Header ----------------------------------
#@NAME       : &IntensityBlur
#@INPUT      : $input - full name of input volume
#              $base  - basename of input volume
#              $blur  - FWHM of blurring kernel - will also be used to
#                       generate the output filename
#@OUTPUT     : 
#@RETURNS    : Full name of the output file.
#@DESCRIPTION: Blurs a volume to the specified FWHM. The output file 
#              will be named according to the specified base filename,
#              with "_xx_blur.mnc", where xx is the FWHM ($blur).
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : Louis Collins (long, long ago)
#@MODIFIED   : 95/08/03, Greg Ward - rearranged to my own liking
#-----------------------------------------------------------------------------
sub IntensityBlur
{
   die "IntensityBlur: wrong number of arguments" 
      unless (@_ >= 4 && @_ <= 5);
   my($input, $base, $blur, $crop, $no_announce) = @_;
   
   my($blurbase) = "${TmpDir}/${base}_${blur}";
   
   &verbose("\nIntensity blurring data:") unless $no_announce;
   if(-e "${blurbase}_blur.mnc") 
   {
      &verbose("${blurbase}_blur.mnc exists");
   }
   else
   {
      my ($tmp_blur) = "${TmpDir}/tmp_${blur}";

      if (-e "${tmp_blur}_blur.mnc")
      {
	 &verbose ("${tmp_blur}_blur.mnc exists");
      }
      else
      {
	 &Spawn (["mincblur", $input, $tmp_blur, "-fwhm", $blur]);
      }
      &Spawn (["autocrop", "${tmp_blur}_blur.mnc", "${blurbase}_blur.mnc",
               "-expand", @$crop]);
      unlink "${tmp_blur}_blur.mnc";
   }
   "${blurbase}_blur.mnc";
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &GradientBlur
#@INPUT      : $input - full name of input volume
#              $base  - basename of input volume
#              $blur  - FWHM of blurring kernel - will also be used to
#                       generate the output filename
#              $keep_intensity 
#                     - if true, we will unpad and keep the intensity blur file
#@OUTPUT     : 
#@RETURNS    : Full names of the output files (intensity then gradient blur).
#              Both are returned even if we toss the intensity file.
#@DESCRIPTION: Blurs a volume to the specified FWHM to get a gradient
#              volume.  The output file will be named according to
#              the specified base filename, with "_xx_blur.mnc" and 
#              "_xx_dxyz.mnc" appended, where xx is the FWHM ($blur).
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : Louis Collins (long, long ago)
#@MODIFIED   : 95/07/28, Greg Ward - rearranged to my own liking
#-----------------------------------------------------------------------------
sub GradientBlur
{
   die "&GradientBlur: wrong number of arguments" 
      unless (@_ >= 4 && @_ <= 6);
   my ($input, $base, $blur, $crop, $keep_intensity, $no_announce) = @_;
   
   my ($blurbase) = "${TmpDir}/${base}_${blur}";
   my $blur_file = "${blurbase}_blur.mnc"; # intensity blur final product
   my $grad_file = "${blurbase}_dxyz.mnc"; # gradient blur final product

   my ($already_done, $done_msg);
   if ($keep_intensity)                 # expect two final output files
   {
      $already_done = -e $blur_file && -e $grad_file;
      $done_msg = "$grad_file and $blur_file already exist";
   }
   else                                 # just expect a gradient file
   {
      $already_done = -e $grad_file;
      $done_msg = "$grad_file already exists";
   }

   &verbose("\nGradient blurring data:") unless $no_announce;
   if ($already_done)
   {
      &verbose($done_msg);
   }
   else
   {
      my $tmp_blur_base = "${TmpDir}/tmp_${blur}";
      my $tmp_blur = $tmp_blur_base . "_blur.mnc";
      my $tmp_grad = $tmp_blur_base . "_dxyz.mnc";
      
      unlink ($grad_file, $blur_file);  # in case one existed but not the other

      if (-e $tmp_blur && -e $tmp_grad)
      {
	 &verbose("$tmp_blur and $tmp_grad already exist");
      }
      else
      {
	 unlink ($tmp_blur, $tmp_grad);
	 &Spawn (["mincblur", $input, $tmp_blur_base,
                  "-fwhm", $blur, "-gradient"]);
      }

      if ($keep_intensity)
      {
         &Spawn (["autocrop", $tmp_blur, $blur_file, "-expand", @$crop]);
      }
      &Spawn (["autocrop", $tmp_grad, $grad_file, "-expand", @$crop]);

      unlink ($tmp_blur, $tmp_grad);
   }

   $keep_intensity
      ? ($blur_file, $grad_file)
      : ($grad_file);

}  # &GradientBlur


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &SetupFits
#@INPUT      : $blurs
#              $blur
#              $volume_cog
#              $final_xfm
#              $input_xfm
#              $default_obj
#              $first_obj
#@OUTPUT     : 
#@RETURNS    : list of fit profiles
#@DESCRIPTION: Sets up an array of hashes that controls the fits.  
#              This way, the fitting procedure itself is quite
#              mechanistic -- everything is set here.
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/07/28, Greg Ward - a distillation of Louis'
#                        original &GradientFit
#@MODIFIED   : 95/07/31, GW: rewrote it to make an array of hashes
#                            instead of a bunch of arrays (sigh)
#-----------------------------------------------------------------------------
sub SetupFits
{
   die "SetupFits: wrong number of arguments" unless @_ == 7;
   my ($blurs, $blur, $volume_cog, $final_xfm, $input_xfm, 
       $default_obj, $first_obj) = @_;
   my (@initial_fits, @final_fits, @fits);

   # And here's where we control the fitting... currently, the fitting
   # steps are as follows:
   #
   #   0) lsq7 16mm intensity blur, unmasked
   #   1) lsq7  8mm intensity blur, unmasked
   #   2) lsq7  8mm gradient blur, masked
   #   3) lsq9  8mm gradient blur, masked
   #   4) check z-scale
   #   5) lsq9  8mm gradient blur, masked
   #   6) lsq9  8mm gradient blur, masked

   # The fields used here are:
   #   program    - the program that actually does something at this
   #                step.  This is a bit deceitful, as only minctracc
   #                actually does any fitting; however, since step 4
   #                is "check_scale", we include that as a member of
   #                the list of fits.  In the future (eg. for nonlinear
   #                stuff), this could also be used as a keyword to 
   #                signify more complicated inter-processing that must
   #                be done between two fits, eg. "prepdata" to prepare
   #                for the 4mm level nonlinear fit.
   #   volume     - this is really the tail end of the names of *both*
   #                volumes (source and target); it will be combined with
   #                the appropriate directories and filename bases to make
   #                two whole filenames.  (This ensures that you will match
   #                similarly-suffixed files, eg.  "foo_8_dxyz" to
   #                "bar_8_dxyz" -- but you cannot do (eg) "foo_8_blur" to
   #                "bar_8_dxyz".)  In this string, 'BASE' will be replaced 
   #                with either the source or target base name, depending
   #                on which filename we're generating.
   #   target
   #   source     - used to generate independent target and source
   #                filenames.  Not used for linear fitting, but comes in
   #                handy in non-linear fitting when we might fit
   #                "specially pre-processed" data (which has a different
   #                base filename, due to the extra processing) to regular
   #                ol' model files.  Use either 'volume' or ('target' and 
   #                'source') -- don't try to mix and match.
   #   init_args  - the arguments used to compute the initial transformation
   #   inputxfm   - the filename tail of the transform file passed to
   #                minctracc as the starting point.  Note that this
   #                is basically a copy of the transforms listed under
   #                `outputxfm', shifted down by one element.  (`init_args'
   #                and `inputxfm' are mutually exclusive.)
   #   outputxfm  - the filename tail for the output transform for
   #                each fit
   #   type       - what kind of fit minctracc is to do (eg. "lsq7")
   #   objective  - objective function to use
   #   sourcemask - file to apply as source mask (-source_mask argument
   #                to minctracc)
   #   targetmask - file to apply as target mask (-model_mask argument
   #                to minctracc)
   #   center     - how to instruct minctracc what to use for the COG
   #                of the source volume (eg. "-est_center" or
   #                "-center 1 2 3")
   #   steps      - number of steps to take in x,y,z (will be preceded
   #                by -step argument to minctracc)
   #   tolerance  - fitting tolerance (will be preceded by -tolerance)
   #   simplex    - radius of simplex search volume (will be preceded by
   #                -simplex)
   #
   # Note: some fields (volume, inputxfm, outputxfm, sourcemask,
   # targetmask) are usually (but not always!) filename tails.  For
   # those values, you must include the string "BASE" somewhere
   # (presumably near the beginning!); it will be replaced with the
   # actual filename base.  For the 'volume' field, this may be
   # replaced by both the source and target base.
   #
   # See &SetupNLFits for a description of the fields used to describe
   # nonlinear fitting.
   
      # check on the default objective function.  If optic, then
      # change to xcorr default for the linear fits.

   if ($default_obj eq 'optic') { 

     warn <<WARN_optic;
$ProgramName: warning: Optical flow not available for linear fitting,
defaulting to xcorr for the linear fitting steps only.
WARN_optic
	 
     $default_obj = 'xcorr';
   }
   
   if (! defined $input_xfm)
   {
      # we only defined fits if $input_xfm is undefined, because if we have
      # an $input_xfm then the $blurs array only has one element -- and
      # trying to access $blurs->[1] triggers an 'undefined' value warning
      # here

      @initial_fits =
         ({ description => "$blurs->[1]mm intensity lsq7 fit, no masks",
            program     => 'minctracc',                   # fit 0
            volume      => "BASE_$blurs->[1]_blur.mnc",
            init_args   => "-est_translations",
            outputxfm   => "BASE_$blurs->[1].xfm",
            type        => "lsq7",
            objective   => $default_obj,
            sourcemask  => "",
            targetmask  => "",
            center      => "-center $volume_cog",
            steps       => [qw/4 4 4/],
            tolerance   => 0.01,
            simplex     => 20 },

          { description => "$blurs->[0]mm intensity lsq7 fit, no masks",
            program     => 'minctracc',                   # fit 1
	    volume      => "BASE_$blurs->[0]_blur.mnc",
	    inputxfm    => "BASE_$blurs->[1].xfm",
	    outputxfm   => "BASE_$blurs->[0]tmp1a.xfm",
	    type        => "lsq7",
            objective   => $default_obj,
	    sourcemask  => "",
	    targetmask  => "",
	    center      => "-center $volume_cog",
	    steps       => [qw/4 4 4/],
	    tolerance   => 0.004,
	    simplex     => 5 },
	   
          { description => "$blurs->[0]mm gradient lsq7 fit, target masked",
            program     => 'minctracc',                   # fit 2
	    volume      => "BASE_$blurs->[0]_dxyz.mnc",
	    inputxfm    => "BASE_$blurs->[0]tmp1a.xfm",
	    outputxfm   => "BASE_$blurs->[0]tmp1b.xfm",
            type        => "lsq7",
            objective   => $default_obj,
	    sourcemask  => "",
	    targetmask  => "BASE_$blurs->[0]_mask.mnc",
	    center      => "-center $volume_cog",
	    steps       => [qw/4 4 4/],
	    tolerance   => 0.004,
	    simplex     => 2 }
         );
   }  # if $input_xfm defined

   # we always define @final_fits, because these fits must always be
   # run for a linear fit

   @final_fits = 
      ({ description => "$blurs->[0]mm gradient lsq9 fit, target masked",
         program     => 'minctracc',                   # fit 3
         volume      => "BASE_$blurs->[0]_dxyz.mnc",
         inputxfm    => "BASE_$blurs->[0]tmp1b.xfm",
         outputxfm   => "BASE_$blurs->[0]tmp2a.xfm",
         type        => "lsq9",
         objective   => $default_obj,
         sourcemask  => "",
         targetmask  => "BASE_$blurs->[0]_mask.mnc",
         center      => "-center $volume_cog",
         steps       => [qw/4 4 4/],
         tolerance   => 0.004,
         simplex     => 2 },

       { description => "checking z-scale",
         program     => "check_scale",                 # "fit" 4
         inputxfm    => "BASE_$blurs->[0]tmp2a.xfm",
         outputxfm   => "BASE_$blurs->[0]tmp2b.xfm" },

       { description => "$blurs->[0]mm gradient lsq9 fit, target masked",
         program     => 'minctracc',                   # fit 5
         volume      => "BASE_$blurs->[0]_dxyz.mnc",
         inputxfm    => "BASE_$blurs->[0]tmp2b.xfm",
         outputxfm   => "BASE_$blurs->[0]tmp2c.xfm",
         type        => "lsq9",
         objective   => $default_obj,
         sourcemask  => "",
         targetmask  => "BASE_$blurs->[0]_mask.mnc",
         center      => "-center $volume_cog",
         steps       => [qw/4 4 4/],
         tolerance   => 0.004,
         simplex     => 2 },

       { description => "final linear fit: " .
                        "$blurs->[0]mm gradient lsq9 fit, target masked",
         program     => 'minctracc',                   # fit 6
         volume      => "BASE_$blurs->[0]_dxyz.mnc",
         inputxfm    => "BASE_$blurs->[0]tmp2c.xfm",
         outputxfm   => "$final_xfm",
         type        => "lsq9",
         objective   => $default_obj,
         sourcemask  => "",
         targetmask  => "BASE_$blurs->[0]_mask.mnc",
         center      => "-center $volume_cog",
         steps       => [qw/4 4 4/],
         tolerance   => 0.004,
         simplex     => 2 }
      );


   # If the user supplied an initial transformation on the command line,
   # then tweak the filename in $final_fits[0] (because that will become
   # the entry point for the whole fitting pipeline), and construct the 
   # whole fit array appropriately.

   if ($input_xfm)
   {
      $final_fits[0]->{'inputxfm'} = $input_xfm;
      @fits = @final_fits;
   }
   else
   {
      @fits = (@initial_fits, @final_fits);
   }

   # If the user specified a different objective function for the
   # first fit only, replace the 'objective' field in the first fit
   # profile

   if ($first_obj)
   {
      $fits[0]->{'objective'} = $first_obj;
   }

   # If no blurring is to be done, then remove any mention of blurred
   # data from the description lines and from the volume names 
   # in all fit profiles.  We leave the name of transform files alone,
   # though, just to keep things consistent with runs that use blurring.

   unless ($blur)
   {
      my $fit;
      for $fit (@fits)
      {
         $fit->{'description'} =~ s/^\d+mm\s+//;
         $fit->{'description'} =~ s/gradient|intensity/unblurred/;
         $fit->{'volume'} = "BASE.mnc";
      }
   }

   return @fits;
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : SetupNLFits
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Sets up the list of 'fit' structures needed for non-linear
#              fitting.  This is similar to SetupFits, but a bit fancier
#              because of the ability to enter/exit the non-linear chain
#              at any point (determined by $start_level and $stop_level).
#@METHOD     : 
#@GLOBALS    : 
#@CALLERS    : 
#@CALLS      : 
#@CREATED    : 1997/09/03, Greg Ward and Louis Collins
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub SetupNLFits
{
   my ($start_index, $stop_index, $input_xfm, $final_xfm, $default_obj) = @_;
   my (%blurs, @nl_fits, %special_pp);

   %blurs =  ('16' => 8, '8' => 8, '4a' => 4, '4b' => 4, '2' => 2);
   die "internal error: \%blurs and \@Levels don't match" 
      unless join ('|', sort keys %blurs) eq join ('|', sort @Levels);


   # TODO
   #   * maybe change 'volume' to 'volumes' (because it tells how
   #     to generate both source and target filenames)


   # Here are the fields used to extend the fit structure to handle 
   # nonlinear fitting (see &SetupFits for a description of the other
   # fields).
   #
   #   level      - the "level" of fit -- corresponds to "-startlevel" 
   #                and "-stoplevel" command-line options
   #   sub_lattice- diameter (in number of nodes) of local sub-lattice 
   #                (default 5)
   #   optimizer  - string specifiying which optimizer to use -- either 
   #                'quadratic' (a straight quadratic fit, not really
   #                an optimization) or 'simplex' (the default)
   #   similarity - weighting factor for  r=similarity*w + cost(1-w) (0.5)
   #   iterations - number of iterations for non-linear optimization (4)
   #   weight     - weighting factor for each iteration in nl optimization
   #                (0.6)
   #   stiffness  - weighting factor for smoothing between nl iterations (0.5)
   #   use_local  - boolean flag to turn on local smoothing 
   #                (if false, the default is global smoothing).
   #   use_noniso - boolean flag to turn on directionally sensitive smoothing
   #                (if false, the default isotropic smoothing.  Note that
   #                local is only worthwhile when noniso is on)
   #   super      - amount (+int) of deformation field super sampling during
   #                optimization (a value of 0 will give -no_super).

   # XXX currently the 'threshold' value is unused because there's only
   # one of them -- nonlinear mode needs two values!  (seems pretty pointless
   # to threshold at a hard-coded absolute value of 0.075, anyways...)

   @nl_fits = 
      ( { level       => '16',
         description => "level 16 nonlinear: $blurs{'16'}mm intensity fit, no masks",
         program     => 'minctracc',
         volume      => "BASE_$blurs{'16'}_blur.mnc",
         inputxfm    => undef,    # filled in later!
         outputxfm   => "BASE_16_nl.xfm",
         type        => 'nonlinear',
         objective   => $default_obj,
         sourcemask  => '',
         targetmask  => '',
         threshold   => 0.075,  # WHAT IS THIS!??!  Louis will check
         steps       => [8, 8, 8],
         sub_lattice => 6,
         optimizer   => 'simplex',
         similarity  => 0.5,
         iterations  => ($default_obj eq 'optic') ? 20  : 12, # 20 iters for optic, else 12
         weight      => ($default_obj eq 'optic') ? 0.5 : 0.5,
         stiffness   => ($default_obj eq 'optic') ? 0.8 : 0.5,
         supersample => 2 },
       { level       => '8',
         description => "level 8 nonlinear: $blurs{'8'}mm intensity fit, no masks",
         program     => 'minctracc',
         volume      => "BASE_$blurs{'8'}_blur.mnc",
         inputxfm    => "BASE_16_nl.xfm",
         outputxfm   => "BASE_8_nl.xfm",
         type        => 'nonlinear',
         objective   => $default_obj,
         sourcemask  => '',
         targetmask  => '',
         threshold   => 0.075,
         steps       => [4, 4, 4],
         sub_lattice => 6,
         optimizer   => 'simplex',
         similarity  => 0.5,
         iterations  => ($default_obj eq 'optic') ? 12  : 8, 
         weight      => ($default_obj eq 'optic') ? 0.6 : 0.6,
         stiffness   => ($default_obj eq 'optic') ? 0.8 : 0.5,
         supersample => 2 },
       { level       => '4a',
         description => "level 4 nonlinear: $blurs{'4a'}mm intensity fit, target masked",
         program     => 'minctracc',
         source      => "BASE_headcrop_$blurs{'4a'}_blur.mnc",
         target      => "BASE_$blurs{'4a'}_blur.mnc",
         inputxfm    => "BASE_8_nlcrop.xfm",
         outputxfm   => "BASE_4_nl.xfm",
         type        => 'nonlinear',
         objective   => $default_obj,
         sourcemask  => '',
         targetmask  => "BASE_$blurs{'4a'}_mask.mnc",
         threshold   => 0.075,
         steps       => [2, 2, 2],
         sub_lattice => 5,
         optimizer   => 'quadratic',
         similarity  => 0.5,
         iterations  => ($default_obj eq 'optic') ? 10  : 5, 
         weight      => ($default_obj eq 'optic') ? 0.8 : 1.0,
         stiffness   => ($default_obj eq 'optic') ? 0.8 : 0.5,
         supersample => 0 },
       { level       => '4b',
         description => "level 4b nonlinear: $blurs{'4b'}mm gradient fit, target masked",
         program     => 'minctracc',
         source      => "BASE_headcrop_$blurs{'4b'}_dxyz.mnc",
         target      => "BASE_$blurs{'4b'}_dxyz.mnc",
         inputxfm    => "BASE_4_nl.xfm",
         outputxfm   => "BASE_4b_nl.xfm",
         type        => 'nonlinear',
         objective   => $default_obj,
         sourcemask  => '',
         targetmask  => "BASE_$blurs{'4b'}_mask.mnc",
         threshold   => 0.075,
         steps       => [2, 2, 2],
         sub_lattice => 5,
         optimizer   => 'quadratic',
         similarity  => 0.5,
         iterations  => ($default_obj eq 'optic') ? 10  : 5, 
         weight      => ($default_obj eq 'optic') ? 0.8 : 1.0,
         stiffness   => ($default_obj eq 'optic') ? 0.8 : 0.5,
         supersample => 0 },
       { level       => '2',
         description => "level 2 nonlinear: $blurs{'2'}mm gradient fit, target masked",
         program     => 'minctracc',
         source      => "BASE_headcrop_$blurs{'2'}_dxyz.mnc",
         target      => "BASE_$blurs{'2'}_dxyz.mnc",
         inputxfm    => "BASE_4b_nl.xfm",
         outputxfm   => "BASE_2_nl.xfm",
         type        => 'nonlinear',
         objective   => $default_obj,
         sourcemask  => '',
         targetmask  => "BASE_$blurs{'2'}_mask.mnc",
         threshold   => 0.075,
         steps       => [1, 1, 1],
         sub_lattice => 5,
         optimizer   => 'quadratic',
         similarity  => 0.5,
         iterations  => ($default_obj eq 'optic') ? 6  : 3, 
         weight      => ($default_obj eq 'optic') ? 0.8 : 1.0,
         stiffness   => ($default_obj eq 'optic') ? 0.8 : 0.5,
         supersample => 0 }
      );


   # there should be a "???" after every entry in this hash... but I didn't
   # bother to put them in, to reduce clutter ;-)
   %special_pp = 
      (description => "special pre-processing for high-resolution " .
                      "nonlinear fits",
       program     => 'special_pp',     # actually, it's a subroutine
       inputxfm    => "BASE_$blurs{'8'}_nl.xfm",
       outputxfm   => "BASE_$blurs{'8'}_nlcrop.xfm",
       cropped     => "BASE_headcrop.mnc",
       blur_fwhm   => undef,            # filled in below
       blur_mode   => undef             # ditto
      );


   my ($i, %index);
   for ($i = 0; $i < @Levels; $i++) { $index{$Levels[$i]} = $i; }
   @nl_fits = grep { $index{$_->{level}} >= $start_index &&
                     $index{$_->{level}} <= $stop_index } @nl_fits;

   if ($start_index >= $index{'4a'})    # will really start with special_pp
   {
      $special_pp{'inputxfm'} = $input_xfm;
      $nl_fits[0]->{'inputxfm'} = $special_pp{'outputxfm'};
   }
   else                                 # will start with a fit
   {
      $nl_fits[0]->{'inputxfm'} = $input_xfm;
   }
   $nl_fits[-1]->{'outputxfm'} = $final_xfm;

   # Clever little hack here.  Figure it out if you dare.  ;-)

   my ($start_level, $stop_level, %special_pp_actions);
   %special_pp_actions = 
      ('4a:4a' => [[4], ['i']],
       '4a:4b' => [[4], ['gi']],
       '4b:4b' => [[4], ['g']],
       '4a:2'  => [[4, 2], ['gi', 'g']],
       '4b:2'  => [[4, 2], ['g', 'g']],
       '2:2'   => [[2], ['g']]);
       
   $start_level = $start_index < $index{'4a'} ? '4a' : $Levels[$start_index];
   $stop_level = $Levels[$stop_index];
   my $action = $special_pp_actions{"$start_level:$stop_level"};
   if (defined $action)
   {
      $special_pp{'blur_fwhm'} = $action->[0];
      $special_pp{'blur_mode'} = $action->[1];
   }
          
   # Hey kids!  See if you can count the potential off-by-one errors here!
   # (Don't try this at home, only to be attempted with adult supervision.)
   my $j = $#nl_fits;
   $j-- until $index{$nl_fits[$j]->{level}} < $index{'4a'} || $j == -1;
   if ($j < $#nl_fits)			# must add "special preprocessing" step
   {
      splice (@nl_fits, $j+1, 0, \%special_pp);
   }

   return @nl_fits;

}  # SetupNLFits


# ----------------------------------------------------------------------
#    &PerformFits and associated routines (in increasing order of importance):
#       &get_full_filename
#       &check_scale
#       &minctracc
#       &perform_fit
# ----------------------------------------------------------------------

# ------------------------------ MNI Header ----------------------------------
#@NAME       : &get_full_filename
#@INPUT      : $fit  - fit profile from which we extract the filename tail
#              $key  - field of the profile to extract
#              $base - base filename (with directory!) to put in place
#                      of "BASE" in the filename tail
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Turns one field from a fit profile (presumably a
#              filename tail) into a full filename by substituting the
#              basename (with directory) in place of "BASE" in the
#              tail.
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/08/01, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub get_full_filename
{
   my ($fit, $key, $base) = @_;
   my ($filename);

   return unless defined $fit->{$key};
   ($filename = $fit->{$key}) =~ s/BASE/$base/;
   $filename;
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &check_scale
#@INPUT      : $in_xfm  - transform file to feed into check_scale
#@OUTPUT     : $out_xfm - transform file that will be output by check_scale
#                         (same as $in_xfm, possibly with z-scale adjusted)
#@RETURNS    : 
#@DESCRIPTION: Calls check_scale on a transform file to make sure the 
#              z-scale factor hasn't gotten out of whack.  (The criteroin
#              is that z-scale must be no more than 15% greater than the
#              average of x-scale and y-scale.  If it is, then it is set
#              to that average.)
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/08/01, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub check_scale
{
   my ($in_xfm, $out_xfm) = @_;
   
   &Spawn (["check_scale", $in_xfm, $out_xfm]);
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &minctracc
#@INPUT      : $source  - base filename (with directory) for source files
#              $model   - base filename (with directory) for model files
#              $fit     - reference to the fit profile used to control
#                         this invocation of minctracc
#              $in_xfm  - full name of input transformation file
#@OUTPUT     : $out_xfm - full name of output transformation file
#@RETURNS    : 
#@DESCRIPTION: 

#              Runs minctracc for one volume->volume fit, with
#              several required and optional parameters taken from the fit
#              profile referenced by $fit.  The required parameters are
#              `volume', `inputxfm', `outputxfm', and `type'.  The optional
#              parameters (for minctracc in linear mode) are `center', `steps',
#              `tolerance', and `simplex'; for nonlinear mode, there are 
#              a ton of optional parameters; see &SetupNLFits.

#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : &get_full_filename
#@CREATED    : 95/08/01, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub minctracc
{
   my ($source, $model, $fit, $in_xfm, $out_xfm) = @_;
   my ($program, $svol, $tvol, $type);
   my ($sourcemask, $targetmask);

   &Fatal ("fit profile is missing some required field")
      unless ($fit->{'program'} &&
              ($fit->{'volume'} || ($fit->{'target'} && $fit->{'source'})) &&
	      ($fit->{'inputxfm'} || $fit->{'init_args'}) && 
	      $fit->{'outputxfm'} &&
	      $fit->{'type'});

   # Pull out the required variables and do any pre-processing needed

   $program = $fit->{'program'};
   if (exists $fit->{'volume'})
   {
      $svol = &get_full_filename ($fit, 'volume', $source);
      $tvol = &get_full_filename ($fit, 'volume', $model);
   }
   else
   {
      $svol = &get_full_filename ($fit, 'source', $source);
      $tvol = &get_full_filename ($fit, 'target', $model);
   }
   $type = $fit->{'type'};
   $sourcemask = &get_full_filename ($fit, 'sourcemask', $source);
   $targetmask = &get_full_filename ($fit, 'targetmask', $model);

   # Pull out the optional variables from the hash (just because I'm
   # a lazy typist)

   my ($objective, $center, $steps, $tolerance, $simplex,
       $optimizer, $supersample) = 
          @{$fit}{qw(objective center steps tolerance simplex 
                     optimizer supersample)};

   # As long as the output xfm file doesn't already exist (or if it
   # does exist, but we're allowed to clobber it), do the fit

   if (-e $out_xfm && !$Clobber)
   {
      &verbose ("$out_xfm already exists");
   }
   else
   {
      my (@options, @steps, @init_options, @center);

      @init_options = 
         $in_xfm ? ('-transformation', $in_xfm)
                 : split (' ', $fit->{'init_args'});
      @center = split (' ', $center) if $center;

      push (@options, "-$objective");
      push (@options, "-source_mask", $sourcemask) if $sourcemask;
      push (@options, "-model_mask", $targetmask) if $targetmask;
      push (@options, @center) if @center;
      push (@options, "-step", @$steps) if $steps;
      push (@options, "-tol", $tolerance) if defined $tolerance;
      push (@options, "-simplex", $simplex) if defined $simplex;

      if ($type eq 'nonlinear')
      {
         push (@options, '-quadratic') if $optimizer eq 'quadratic';

         for my $param (qw(sub_lattice similarity 
                        iterations weight stiffness))
         {
            push (@options, "-$param", $fit->{$param})
               if defined $fit->{$param};
         }
         push (@options, 
               ($supersample == 0) ? ('-no_super') : ('-super', $supersample));
      }

      &Spawn (['minctracc', $svol, $tvol, $out_xfm, @init_options, "-$type",
               @options]);
   }
}  # &minctracc


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &hack_nonlinear_xfm
#@INPUT      : $in_xfm
#              $out_xfm
#              $new_deform
#@OUTPUT     : 
#@RETURNS    : ($old_deform, $new_deform)
#                 - $old_deform is the name of the deformation field volume
#                   extracted from $in_xfm; $new_deform is the passed-in
#                   value, but with the directory component of $out_xfm
#                   prepended
#              OR empty list, if no deformation grid filename was found in
#                $in_xfm (eg. it's a linear or TPS transformation)
#@DESCRIPTION: Reads a nonlinear transform file, extracts the name of the
#              deformation field filename stored in it, and writes a new xfm
#              file with a new deformation file.
#@METHOD     : 
#@CALLERS    : special_preprocess
#@CALLS      : 
#@CREATED    : 1997/09/12, GPW (extracted from &special_pp)
#@MODIFIED   : 
#@COMMENTS   : This is very, very naughty code -- poking about the innards
#              of a an xfm file like this is EVIL!!!  (...got a better idea?)
#-----------------------------------------------------------------------------
sub hack_nonlinear_xfm
{
   my ($in_xfm, $out_xfm, $new_deform) = @_;
   my $old_deform;

   open (INXFM, $in_xfm) || die "couldn't open $in_xfm: $!\n";
   open (OUTXFM, ">$out_xfm") || die "couldn't create $out_xfm: $!\n";

   my $comment = <<COMMENT;
% $ProgramName: special pre-processing for later non-linear fits
% created $out_xfm 
% from $in_xfm
COMMENT
   my ($prev_was_comment, $wrote_comment);

   while (<INXFM>)
   {
      # put our own comment just before the first blank line after a
      # comment, or before the first "real content" line (in case that
      # blank line isn't there)

      if (((/^\s*$/ && $prev_was_comment) || # blank line after a comment
           (/^Transform_Type/)) &&           # first "real content"
          !$wrote_comment)                   # haven't already written it!
      {
         print OUTXFM $comment;
         $wrote_comment = 1;
      }

      # change the deformation field filename when we find it

      if (/^Displacement_Volume \s* = \s* ([^;]+);/x)
      { 
         print OUTXFM "Displacement_Volume = $new_deform;\n";
         $old_deform = $1;
      }
      else
      {
         print OUTXFM;
      }

      $prev_was_comment = /^%/;
   }
   close INXFM;
   close OUTXFM;

   return () unless defined $old_deform;

   $old_deform = (&split_path ($in_xfm))[0] . $old_deform
      unless ($old_deform =~ m|^/|);
   $new_deform = (&split_path ($out_xfm))[0] . $new_deform
      unless ($new_deform =~ m|^/|);

   ($old_deform, $new_deform);
}  # &hack_nonlinear_xfm


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &special_preprocess
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Performs the "special pre-processing" used to save time
#              and space as a prelude to the level-4 and level-2 nonlinear
#              fits.
#@METHOD     : 
#@GLOBALS    : $TmpDir (?), $KeepTmp
#@CALLERS    : 
#@CALLS      : 
#@CREATED    : 1997/09/09, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub special_preprocess
{
   my ($source_vol, $source, $model, $fit, $in_xfm, $out_xfm) = @_;
   my ($model_mask, $source_mask, $linear_xfm);

#   $tmp_dir = "$TmpDir/special_pp";
#   check_output_dirs ($tmp_dir) || exit 1;

   $model_mask = $model . "_headmask.mnc";
   $source_mask = $source . "_headmask.mnc";
   $linear_xfm = $source . "_lin.xfm";

   # First, extract the linear component from the current nonlinear xfm
   # ($in_xfm), and use it to resample the model headmask back to native
   # space

   if (-e $source_mask && !$Clobber)
   {
      &verbose ("$source_mask already exists");
   }
   else
   {
      # four cases governing how to create $linear_xfm:
      #   exists && clobber    : unlink, run xfmtool
      #   exists && !clobber   : skip completely
      #   !exists && clobber   : [unlink,] run xfmtool
      #   !exists && !clobber  : run xfmtool

      unlink $linear_xfm                # because xfmtool can't clobber
         if -e $linear_xfm && $Clobber;
      Spawn (['xfmtool', "extract(1):$in_xfm", $linear_xfm])
         unless -e $linear_xfm;

      Spawn (['mincresample', $model_mask, $source_mask,
              '-byte', '-nearest_neighbour',
              '-transformation', $linear_xfm, '-invert',
              '-like', $source_vol]);
   }


   # Now compute the bounding box of the transformed headmask, and use it
   # to crop the original native MRI 

   # XXX should we force cubic voxels in the MRI here??? (could do it by
   # getting steps from $source_vol, finding the minimum of them, and
   # passing that to autocrop with '-isostep').  If we do we can just
   # skip the call to volume_params, because we'll have to figure out
   # what the steps are to be before running autocrop anyways.

   my $cropped_mri = &get_full_filename ($fit, 'cropped', $source);
   my @steps;
   volume_params ($source_vol, undef, \@steps);
   my ($pad, $unpad) = &pad_amounts ($fit->{'blur_fwhm'}, \@steps, 0);

   if (-e $cropped_mri && !$Clobber)
   {
      &verbose ("$cropped_mri already exists");
   }
   else
   {
      Spawn (['autocrop', $source_vol, $cropped_mri, 
              '-bbox', $source_mask, '-expand', @$pad]);
   }
   unlink $source_mask unless $KeepTmp;


   # Now blur the cropped MRI as many times as are required by the
   # 'blur_fwhm' field in $fit

   my $crop_base = (&split_path ($cropped_mri))[1];
   my $i;
   for $i (0 .. $#{$fit->{'blur_fwhm'}})
   {
      &SelectiveBlur ($cropped_mri, $crop_base, 
                      $fit->{'blur_fwhm'}[$i], $unpad->[$i], $fit->{'blur_mode'}[$i]);
   }


   # Finally, we create the new (cropped) nonlinear transform.  This has
   # two steps: create the new .xfm file, and create the new deformation
   # field.  We create the new .xfm file first, because we basically
   # copy the old one to the new one; along the way, we pull out the name
   # of the old deformation field, and drop in the name of the new one.
   # That old field will be cropped to create the new field, thus
   # making the new .xfm file valid.

   my ($input_def, $cropped_def);

   if ($Execute)                        
   {                                    
      # find the real name of the input deformation field (and create a new
      # xfm file using the cropped field)

      $cropped_def = (&split_path ($out_xfm))[1] . '_grid_0.mnc';
      ($input_def, $cropped_def) = 
         hack_nonlinear_xfm ($in_xfm, $out_xfm, $cropped_def);

      if (! $input_def)                 # didn't find a grid filename 
      {                                 # in $in_xfm
         warn <<WARN;
$ProgramName: warning: no deformation grid filename found in $in_xfm
(initializing a level-4 or level-2 nonlinear fit with a linear transformation
is not recommended!)
WARN
         undef $cropped_def;
      }
   }
   else
   {
      # just take a guess that'll look good

      ($input_def = $in_xfm) =~ s/\.xfm$/_grid_0.mnc/;
      ($cropped_def = $out_xfm) =~ s/\.xfm$/_grid_0.mnc/;
   }

   # Speaking of evil and naughty, it is *critical* that we force autocrop
   # to use mincresample here -- this is due to autocrop's ignorance of
   # anything other than 3-dimensional volumes.  Basically, it works as
   # long as we only ask it to read the steps of the volume -- which is all
   # that's really needed to use mincresample.  To use mincreshape, though,
   # it has to do a lot more, and there it falls down.  (Actually, it runs
   # just fine, but produces garbage.  Sigh.)

   if ($cropped_def && -e $cropped_def && !$Clobber)
   {
      &verbose ("$cropped_def already exists");
   }
   elsif ($cropped_def)                 # don't crop if we don't have a 
   {                                    # deformation grid!
      Spawn (['autocrop', $input_def, $cropped_def, 
              '-bbox', $model_mask, '-resample', '-isoexpand', '1v']);
   }

}  # &special_preprocess



# ------------------------------ MNI Header ----------------------------------
#@NAME       : &perform_fit
#@INPUT      : $source_vol - complete name of original input volume
#              $source     - temporary basename for input files (i.e.,
#                            temp dir + basename (source_vol))
#                            (used to find blurred volumes and temp xfm files)
#              $model  - base filename (with directory!) of target volume
#              $fit    - reference to the fit profile (hash) for this step
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Performs one step of the overall fitting scheme.  Currently,
#              this can be either a run of minctracc or check_scale.
#              Important fit parameters are taken from the fit profile
#              referenced by $fit; which of these parameters are required
#              depends on the exact activity performed here.
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/08/01, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub perform_fit
{
   my ($source_vol, $source, $model, $fit) = @_;
   my ($program, $in_xfm, $out_xfm, $desc);

   # Get the program name, default to minctracc if none supplied
   $program = $fit->{'program'};
   $in_xfm = &get_full_filename ($fit, 'inputxfm', $source);
   $out_xfm = &get_full_filename ($fit, 'outputxfm', $source);
   $desc = $fit->{'description'};
   $desc .= ": making " . $out_xfm
      if ($desc && $out_xfm);

   &verbose ("\n" . $desc);

   if ($program eq 'check_scale')
   {
      &check_scale ($in_xfm, $out_xfm);
   }
   elsif ($program eq 'minctracc')
   {
      &minctracc ($source, $model, $fit, $in_xfm, $out_xfm);
   }
   elsif ($program eq 'special_pp')
   {
      &special_preprocess ($source_vol, $source, $model,
                           $fit, $in_xfm, $out_xfm);
   }
   else
   {
      die "perform_fit: unknown program \"$program\"";
   }
}



# ------------------------------ MNI Header ----------------------------------
#@NAME       : &PerformFits
#@INPUT      : $fits  - the list of fit profiles as constructed by 
#                       SetupFits (and possibly SetupNLFits)
#              $source_vol  - name of original input volume
#              $source_base - base name (no directory) of source volume
#              $model - base name (with directory!) of target volumes
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: Runs the whole fitting procedure, by calling &perform_fit
#              once for each element in the Grand High List Of Fit
#              Profiles (passed in as $fits).
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 95/08/01, Greg Ward
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub PerformFits 
{
   my ($fits, $source_vol, $source_base, $model) = @_;
   my ($source, $fit);

   # Base name/directory for blurred files and temporary xfm's

   $source = "${TmpDir}/${source_base}";

   for $fit (@$fits)
   {
      &perform_fit ($source_vol, $source, $model, $fit);
   }
}


# ------------------------------ MNI Header ----------------------------------
#@NAME       : &verbose
#@INPUT      : $str - message to print
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: prints message, as long as global $Verbose flag is true
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : Louis Collins
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub verbose
{
   print "@_\n" if $Verbose;
}
