#! /usr/bin/env perl
#
# Andrew Janke - a.janke@gmail.com
#
# Copyright Andrew Janke
# The Australian National 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 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.1.0';
my $PACKAGE_BUGREPORT = '"Andrew Janke" <a.janke@gmail.com>';

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

$me = &basename($0);
%opt = (
   'verbose' => 0,
   'clobber' => 0,
   'swap' => undef,
   'stepscale' => undef,
   'resetsampling' => undef,
   'salami' => undef,
   'sandwich' => undef,
   );

$Help = <<HELP;
| $me does various dodgy things to a MINC file that you really
|    should not ever have to do but often are forced to due
|    to broken conversions and the likes.
|
| In short, I dont like this and it should not be used unless
|    you like living on the edge. Things like opening cereal
|    packets the wrong way up, drinking undiluted cordial,
|    and eating out of date pistachio nuts while swimming with
|    canadians.
|
| Note that using multiple C/L arguments all at once and expecting
|    them all to play nice with each other will produce
|    "surprising" results and odds are not pleasant ones.
|
| Problems or comments should be sent to: a.janke\@gmail.com
HELP

$Usage = "Usage: $me [options] <infile.mnc> <outfile.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" ],
   ["-clobber", "boolean", 0, \$opt{'clobber'},
      "clobber existing check files" ],
   ["-fake", "boolean", 0, \$opt{'fake'},
      "do a dry run, (echo cmds only)" ],

   ["-swap", "string", '1', \$opt{'swap'},
      "swap the indicated dimensions. Usually only needed" .
      " after a bodgy conversion from some other brain dead format" .
      " that has no clue about Up/Down let alone Left from Right" .
      "eg: 'yz'" ],

   ["-stepscale", "float", '1', \$opt{'stepscale'},
      "scale the steps (And start) in all dimensions" .
      " usually for messing with little data" ],

   ["-resetdircos", "boolean", 0, \$opt{'resetdircos'},
      "reset the direction cosines to the default"],

   ["-resetsampling", "string", 1, \$opt{'resetsampling'},
      "reset the starts and steps of the input volume to the specified volume"],

   ["-salami", "string", 1, \$opt{'salami'},
      "extract a regular series of slices from a volume " .
      "syntax: <offset>+<step><dimension> " .
      "[offset: number of slices to skip first] ".
      "[step: number of slices to skip between slices] ".
      "[dimension: dimension in which to slice] ".
      "eg: 5+2z = every 2nd slice in z starting with the 5th slice"],

   ["-sandwich", "string", 1, \$opt{'sandwich'},
      "insert blank slices between slices in a volume " .
      "syntax: <offset>+<insert><dimension> " .
      "[offset: number of slices to skip first] ".
      "[insert: number of slices to insert between slices] ".
      "[dimension: dimension in which to insert] ".
      "eg: 5+2z = every 2nd slice in z starting with the 5th slice"],
   );

# get history string
chomp($history = `date`);
$history .= '>>>> ' . join(' ', $me, @ARGV) . "\n";

# check args
&Getopt::Tabular::SetHelp($Help, $Usage);
&GetOptions(\@opt_table, \@ARGV) || exit 1;
die $Usage if($#ARGV != 1);
$infile = shift(@ARGV);
$outfile = shift(@ARGV);

# check for files
die "$me: Couldn't find input file: $infile\n" if (!-e $infile);
if(-e $outfile && !$opt{'clobber'}){
   die "$me: $outfile exists, -clobber to overwrite\n";
   }

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

if(defined($opt{'swap'})){
   my($first_dir, $second_dir);

   # get the -swap thingos
   $first_dir = substr($opt{'swap'}, 0, 1);
   $second_dir = substr($opt{'swap'}, 1, 1);

   # mashing time
   open(HDR, "mincheader $infile |");
   open(OUT, " | mincgen -o $outfile");

   # time to fiddle
   foreach (<HDR>){
      s/${first_dir}space/froodypooopers/g;
      s/${second_dir}space/${first_dir}space/g;
      s/froodypooopers/${second_dir}space/g;

      print OUT;
      }

   close(HDR);
   close(OUT);

   # copy the data over
   &do_cmd('minccopy', $infile, $outfile);

   # now fix up a few things
   my($a, $b);

   # swap dimension comments (or else risk subsequent confusion!)
   chomp($a = `mincinfo -attvalue ${first_dir}space:comments $outfile`);
   chomp($b = `mincinfo -attvalue ${second_dir}space:comments $outfile`);
   &do_cmd('minc_modify_header', '-sinsert', "${first_dir}space:comments=$b", $outfile);
   &do_cmd('minc_modify_header', '-sinsert', "${second_dir}space:comments=$a", $outfile);

   # swap any direction cosines that might exist
   chomp($a = `mincinfo -error_string NONE -attvalue ${first_dir}space:direction_cosines $outfile`);
   chomp($b = `mincinfo -error_string NONE -attvalue ${second_dir}space:direction_cosines $outfile`);

   # handle the case where only one dimension has direction_cosines
   &do_cmd('minc_modify_header',
      '-delete', "${first_dir}space:direction_cosines", $outfile);
   &do_cmd('minc_modify_header',
      '-delete', "${second_dir}space:direction_cosines", $outfile);

   if($a ne "NONE"){
      $a =~ s/\ $//;
      $a =~ s/\ /\,/g;
      &do_cmd('minc_modify_header',
         '-dinsert', "${second_dir}space:direction_cosines=$a", $outfile);
      }

   if($b ne "NONE"){
      $b =~ s/\ $//;
      $b =~ s/\ /\,/g;
      &do_cmd('minc_modify_header',
         '-dinsert', "${first_dir}space:direction_cosines=$b", $outfile);
      }
   }

# scale steps
if(defined($opt{'stepscale'})){
   my($xstep, $ystep, $zstep, $xstart, $ystart, $zstart);

   print STDOUT "Scaling steps/starts by $opt{'stepscale'}\n";

   &do_cmd('cp', $infile, $outfile);

   # get steps
   chomp($xstep = `mincinfo -attvalue xspace:step $infile`);
   chomp($ystep = `mincinfo -attvalue yspace:step $infile`);
   chomp($zstep = `mincinfo -attvalue zspace:step $infile`);

   chomp($xstart = `mincinfo -attvalue xspace:start $infile`);
   chomp($ystart = `mincinfo -attvalue yspace:start $infile`);
   chomp($zstart = `mincinfo -attvalue zspace:start $infile`);

   # scale them
   $xstep *= $opt{'stepscale'};
   $ystep *= $opt{'stepscale'};
   $zstep *= $opt{'stepscale'};

   $xstart *= $opt{'stepscale'};
   $ystart *= $opt{'stepscale'};
   $zstart *= $opt{'stepscale'};

   print STDOUT "Setting to \n   ($xstart:$ystart:$zstart)\n   ($xstep:$ystep:$zstep)\n";

   # put them back in
   &do_cmd('minc_modify_header', '-dinsert', "xspace:step=$xstep", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "yspace:step=$ystep", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "zspace:step=$zstep", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "xspace:start=$xstart", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "yspace:start=$ystart", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "zspace:start=$zstart", $outfile);
   }

# reset direction cosines
if(defined($opt{'resetdircos'})){
   print STDOUT "Resetting direction cosines\n";

   # if nothing else done already
   if(!-e $outfile){
      &do_cmd('cp', $infile, $outfile);
      }

   # reset cosines
   &do_cmd('minc_modify_header', '-dinsert', "xspace:direction_cosines=1,0,0", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "yspace:direction_cosines=0,1,0", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "zspace:direction_cosines=0,0,1", $outfile);
   }

# reset starts and steps to be akin to the input volume
if(defined($opt{'resetsampling'})){
   my($xstep, $ystep, $zstep, $xstart, $ystart, $zstart);

   print STDOUT "Setting steps/starts of $outfile to $opt{'resetsampling'}\n";

   &do_cmd('cp', $infile, $outfile);

   # get steps
   chomp($xstep = `mincinfo -attvalue xspace:step $opt{'resetsampling'}`);
   chomp($ystep = `mincinfo -attvalue yspace:step $opt{'resetsampling'}`);
   chomp($zstep = `mincinfo -attvalue zspace:step $opt{'resetsampling'}`);

   chomp($xstart = `mincinfo -attvalue xspace:start $opt{'resetsampling'}`);
   chomp($ystart = `mincinfo -attvalue yspace:start $opt{'resetsampling'}`);
   chomp($zstart = `mincinfo -attvalue zspace:start $opt{'resetsampling'}`);

   # put them back in
   &do_cmd('minc_modify_header', '-dinsert', "xspace:step=$xstep", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "yspace:step=$ystep", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "zspace:step=$zstep", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "xspace:start=$xstart", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "yspace:start=$ystart", $outfile);
   &do_cmd('minc_modify_header', '-dinsert', "zspace:start=$zstart", $outfile);
   }

# salami
if(defined($opt{'salami'})){
   my($offset, $step, $direction, $i, $dimlength, $dimstart, $dimstep);
   my($cstart, $cstep, @cfiles);

   # parameter extraction
   ($offset, $step, $direction) = $opt{'salami'} =~ m/(\d+)\+(\d+)([a-z]+)/;

   $direction = "xspace" if $direction eq "x";
   $direction = "yspace" if $direction eq "y";
   $direction = "zspace" if $direction eq "z";

   print STDOUT "Salami, $offset + $step in $direction\n" if $opt{'verbose'};

   # get existing start and step
   chomp($dimlength = `mincinfo -dimlength ${direction} $infile`);
   chomp($dimstart = `mincinfo -attvalue ${direction}:start $infile`);
   chomp($dimstep = `mincinfo -attvalue ${direction}:step $infile`);

   # calculate new step and start
   $cstep = $dimstep * $step;
   $cstart = $dimstart + ($offset * $dimstep);

   print STDOUT "Getting slices [$offset+$step$direction]: ";
   @cfiles = ();
   for($i=$offset; $i < $dimlength; $i += $step){
      print STDOUT "$i ";
      &do_cmd("mincreshape", "-quiet",
         "-dimrange", "${direction}=$i,0",
         $infile, "$tmpdir/$i.mnc");

      push(@cfiles, "$tmpdir/$i.mnc");
      }
   print STDOUT "\n";

   print STDOUT "Concat ";
   &do_cmd("mincconcat", "-clobber",
      "-concat_dimension", ${direction},
      "-step", $cstep, "-start", $cstart,
      @cfiles, $outfile);
   }

# sandwich
if(defined($opt{'sandwich'})){
   my($offset, $insert, $direction, $i, $j, $dimlength, $dimstart, $dimstep);
   my($cstart, $cstep, @cfiles);

   # parameter extraction
   ($offset, $insert, $direction) = $opt{'sandwich'} =~ m/(\d+)\+(\d+)([a-z])/;

   print STDOUT "Sandwich, $offset + $insert in $direction\n" if $opt{'verbose'};

   # get existing start and step
   chomp($dimlength = `mincinfo -dimlength ${direction}space $infile`);
   chomp($dimstart = `mincinfo -attvalue ${direction}space:start $infile`);
   chomp($dimstep = `mincinfo -attvalue ${direction}space:step $infile`);

   # calculate new start
   $cstep = $dimstep * 1;
   $cstart = $dimstart + ($offset * $dimstep);

   # make blank slice
   &do_cmd("mincreshape",
      "-dimrange", "${direction}space=-1,0",
      $infile, "$tmpdir/blank.mnc");

   print STDOUT "Getting slices [$offset+$insert$direction]: ";
   @cfiles = ();
   for($i=$offset; $i < $dimlength; $i++){
      print STDOUT "[$i/$dimlength] ";
      &do_cmd("mincreshape", "-quiet",
         "-dimrange", "${direction}space=$i,0",
         $infile, "$tmpdir/$i.mnc");

      push(@cfiles, "$tmpdir/$i.mnc");

      # add blank slices (except last)
      if($i != $dimlength - 1){
         for($j=0; $j<$insert; $j++){
            push(@cfiles, "$tmpdir/blank.mnc");
            }
         }
      }
   print STDOUT "\n";

   print STDOUT "Concat ";
   &do_cmd("mincconcat", "-clobber",
      "-concat_dimension", "${direction}space",
      "-step", $cstep, "-start", $cstart,
      @cfiles, $outfile);
   }

# add the history string to the output file
&do_cmd('minc_modify_header',
   '-sappend', ":history='$history'",
   $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;
   }
