#! /usr/bin/env perl
#
# rescale a minc image within a range
#
# Andrew Janke - a.janke@gmail.com
#
# Copyright Andrew Janke, The University of Queensland.
# 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 the University make no representations about the
# suitability of this software for any purpose.  It is provided "as is"
# without express or implied warranty.


use strict;
use warnings "all";
use Getopt::Tabular;
use File::Basename;
use File::Temp qw/ tempdir /;

# until I get organised and do this properly
my $PACKAGE = &basename($0);
my $VERSION = '1.2.1';
my $PACKAGE_BUGREPORT = '"Andrew Janke" <a.janke@gmail.com>';

my($Help, $Usage, $me, @opt_table, %opt);
my(@args, $args, @mask_args, $infile, $outfile, $tmpdir);

$me = basename($0);
%opt = (
   'verbose' => 0,
   'quiet', => 0,
   'clobber' => 0,
   'fake' => 0,
   'outtype' => '-filetype',
   'mask' => undef,
   'cutoff' => 0.01,
   'lowwer' => undef,
   'upper' => undef,
   'clamp' => 1,
   'out_floor' => 0,
   'out_ceil' => 100,
   'threshold' => 0,
   'threshold_blur' => 2,
   'threshold_perc' => 0.1,
   'threshold_bmt' => undef,
   'threshold_mask' => undef,
   );

$Help = <<HELP;
 | $me normalises a file between a max and minimum (possibly)
 |       using two histogram pct's.
 |
 | Problems or comments should be sent to: a.janke\@gmail.com
HELP

$Usage = "\nUsage: $me [options] <in.mnc> <out.mnc>\n".
           "       $me -help to list options\n\n";

@opt_table = (
   ["General Options", "section" ],
   ["-version", "call", 0, \&print_version_info,
      "print version and exit" ],
   ["-verbose", "boolean", 0, \$opt{'verbose'},
      "be verbose" ],
   ["-quiet", "boolean", 0, \$opt{'quiet'},
      "be quiet" ],
   ["-clobber", "boolean", 0, \$opt{'clobber'},
      "clobber existing files" ],
   ["-fake", "boolean", 0, \$opt{'fake'},
      "do a dry run, (echo cmds only)" ],

   ["-byte", "copy", undef, \$opt{'outtype'},
      "Output in byte format"],
   ["-short", "copy", undef, \$opt{'outtype'},
      "Output in short format"],
   ["-int", "copy", undef, \$opt{'outtype'},
      "Output in int format"],
   ["-float", "copy", undef, \$opt{'outtype'},
      "Output in float format"],
   ["-double", "copy", undef, \$opt{'outtype'},
      "Output in double format"],

   ["Normalisation Options", "section" ],
   ["-mask", "string",  1, \$opt{'mask_fn'},
      "calculate the image normalisation within a mask",
      "<mask.mnc>"],
   ["-clamp", "boolean", 0, \$opt{'clamp'},
      "Force the ouput range between limits" ],
   ["-cutoff", "float", 1, \$opt{'cutoff'},
      "cutoff value to use to calculate thresholds by a histogram PcT in %." ],
   ["-lower", "float", 1, \$opt{'lower'},
      "lower real value to use" ],
   ["-upper", "float", 1, \$opt{'upper'},
      "upper real value to use" ],
   ["-out_floor", "float", 1, \$opt{'out_floor'},
      "output files maximum" ],
   ["-out_ceil", "float", 1, \$opt{'out_ceil'},
      "output files minimum" ],

   ["Threshold Options", "section" ],
   ["-threshold", "boolean",  0, \$opt{'threshold'},
      "Threshold the image (set values below threshold_perc to -out_floor"],
   ["-threshold_perc", "float", 1, \$opt{'threshold_perc'},
      "threshold percentage (0.1 == lower 10% of intensity range)" ],
   ["-threshold_bmt", "boolean", 1, \$opt{'threshold_bmt'},
      "use the resulting image BiModalT as the threshold" ],
   ["-threshold_blur", "float", 1, \$opt{'threshold_blur'},
      "blur FWHM for intensity edges then thresholding"],
   ["-threshold_mask", "string", 1, \$opt{'threshold_mask'},
      "file in which to store the threshold mask"],
   );

# Check arguments
&Getopt::Tabular::SetHelp ($Help, $Usage);
&GetOptions (\@opt_table, \@ARGV) || exit 1;
die $Usage if ($#ARGV != 1);

# set up and check for file names
$infile = $ARGV[0];
$outfile = $ARGV[1];
die "$me: Couldn't find $infile\n\n" if (!-e $infile);
if(!$opt{'clobber'} && -e $outfile){
   die "$me: $outfile exists!, use -clobber to overwrite\n\n";
   }
if(!$opt{'clobber'} && defined($opt{'threshold_mask'}) && -e $opt{'threshold_mask'}){
   die "$me: $opt{'threshold_mask'} exists!, use -clobber to overwrite\n\n";
   }

# make tmpdir
$tmpdir = &tempdir( "$me-XXXXXXXX", TMPDIR => 1, CLEANUP => 1 );


my($l_pct, $u_pct, $range, $eqn);

@mask_args = ();
if(defined($opt{'mask_fn'})){
   die "$me: Couldn't find $opt{'mask_fn'}\n\n" if (!-e $opt{'mask_fn'});
   @mask_args = ('-mask', $opt{'mask_fn'}, '-mask_binvalue', 1);
   }


# figure out upper and lowwer bounds if required
if(!defined($opt{lower})){
   $l_pct = $opt{'cutoff'};
   print STDOUT "*** getting lower range of $infile [$l_pct]\n" if !$opt{quiet};
   @args = ('mincstats', '-quiet', @mask_args, '-pctT', $l_pct, $infile);
   $args = join(' ', @args);
   print STDOUT "$args\n" if $opt{'verbose'};
   chomp($opt{lower} = `$args`);
   }

if(!defined($opt{upper})){
   $u_pct = 100 - $opt{'cutoff'};
   print STDOUT "*** getting upper range of $infile [$u_pct]\n" if !$opt{quiet};
   @args = ('mincstats', '-quiet', @mask_args, '-pctT', $u_pct, $infile);
   $args = join(' ', @args);
   print STDOUT "$args\n" if $opt{'verbose'};
   chomp($opt{upper} = `$args`);
   }

# first rescale between 0 and 1
$range = $opt{upper} - $opt{lower};
if($opt{clamp}){
   $eqn = "((A[0] < $opt{lower}) ? 0.0 : (A[0] > $opt{upper}) ? 1.0 : (A[0]-$opt{lower})/$range)",
   }
else{
   $eqn = "(A[0]-$opt{lower})/$range",
   }
# the scale to required range
$eqn .= " * " . ($opt{out_ceil} - $opt{out_floor}) . " + $opt{out_floor};";

# do the rescaling
print STDOUT "*** scaling $infile in range [$opt{lower}:$opt{upper}]\n" if !$opt{'quiet'};
print STDOUT "*** outputting in the range  [$opt{out_floor}:$opt{out_ceil}]\n" if !$opt{'quiet'};
&do_cmd('minccalc', '-clobber',
   $opt{'outtype'},
   '-expression', $eqn,
   $infile, (($opt{'threshold'}) ? "$tmpdir/rescaled.mnc" : $outfile));


# threshold if required
if($opt{'threshold'}){
   my ($thresh, $maskfn);

   # figure out the threshold for masking
   if($opt{'threshold_bmt'}){
      chomp($thresh = `mincstats -quiet -biModalT $tmpdir/rescaled.mnc`);
      }
   else{
      $thresh = $opt{'out_ceil'} * $opt{'threshold_perc'};
      }

   # first make a mask
   $maskfn = (defined $opt{'threshold_mask'})
      ? $opt{'threshold_mask'} : "$tmpdir/thresh-mask.mnc";
   &do_cmd('mincmath', '-clobber',
      '-gt',
      '-const', $thresh,
      "$tmpdir/rescaled.mnc", $maskfn);

   # blur it
   &do_cmd('mincblur', '-clobber',
      '-fwhm', $opt{'threshold_blur'},
      $maskfn, "$tmpdir/thresh-mask");

   # then apply it
   &do_cmd('mincmath', '-clobber',
      '-mult',
      "$tmpdir/rescaled.mnc", "$tmpdir/thresh-mask_blur.mnc",
      $outfile);
   }





sub do_cmd {
   print STDOUT "@_\n" if $opt{'verbose'};
   if(!$opt{'fake'}){
      system(@_) == 0 or die;
      }
   }

sub print_version_info {
   print STDOUT "\n$PACKAGE version $VERSION\n".
                "Comments to $PACKAGE_BUGREPORT\n\n";
   exit;
   }
