#! /usr/bin/env perl
#
# siemens_mosaic2mnc
#
# Andrew Janke - a.janke@gmail.com
# Center for Magnetic Resonance
# The University of Queensland
# http://www.cmr.uq.edu.au/~rotor
#
# See POD section for LICENCE


$| = 1;
use strict;
use warnings "all";
use Getopt::Tabular;
use File::Basename;
use File::Temp qw/ tempdir /;

use vars qw($VERSION);
$VERSION = '1.0';


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

$me = basename($0);
%opt = (
   'verbose'   => 0,
   'quiet'     => 0,
   'debug'     => 0,
   'clobber'   => 0,
   'fake'      => 0,
   ); 

$Help = <<HELP;
 | Siemens Dicom Mosaic file format converter
 |
 | $me works primarily by using the ##ASC_CONV## section
 |    of a siemens Mosaic file.
 |
 | Problems/comments to: rotor\@cmr.uq.edu DOT au
HELP

$Usage = "Usage: $me [options] <in_mosaic.IMA> <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" ],
   ["-quiet", "boolean", 0, \$opt{quiet},
      "be quiet" ],
   ["-debug", "boolean", 0, \$opt{debug},
      "spew copious output" ],
   ["-clobber", "boolean", 0, \$opt{clobber},
      "clobber existing files" ],
   ["-fake", "boolean", 0, \$opt{fake},
      "do a dry run, (echo cmds only)" ],
   );

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

# Check arguments
&Getopt::Tabular::SetHelp($Help, $Usage);
&GetOptions(\@opt_table, \@ARGV) || exit 1;
if($#ARGV != 1){ die $Usage; }
$infile  = $ARGV[0];
$outfile = $ARGV[1];

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

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

# variables
my($buf, $i, $j, $n, $gen_hdr, %siemens_hdr);
my(@dimcodes, @dimnames, @dim_idx, @slice_pos, @slice_nrm);

# have a hunt for the ASCCONV header
my($ref, $hsh, $idx, $text);
print STDOUT " +++ Seeking ASCCONV header in $infile\n" if !$opt{quiet};
open(FH, "<$infile");
do {
   chomp($buf = <FH>);   
   } until (index($buf, "### ASCCONV BEGIN ###") != -1);

# copy the header into a hash
print STDOUT " +++ Getting ASCCONV elements: " if !$opt{quiet};
$buf = <FH>;
for($i=0; (index($buf, "### ASCCONV END ###") == -1); $buf = <FH>, $i++){
   my($key, $value);
   
   chomp($buf);
   ($key, $value) = split(/\s*\=\s*/, $buf, 2);
   
   $ref = '$siemens_hdr';
   foreach (split(/\./, $key)){
      if($_ =~ m/\[\d*\]$/){
         ($hsh, $idx) = ($_ =~ m/(.*?)\[(\d*)\]$/);
         $text = "{'$hsh'}[$idx]";
         }
      else{
         $text = "{'$_'}";
         }
      $ref .= $text;
      }   
   $ref .= " = $value";
   eval($ref);
   
   print STDOUT "." if !$opt{quiet};
   }
close(FH);
print STDOUT "Done. ($i elements read)\n" if !$opt{quiet};

if($opt{debug}){
   use Data::Dumper;
   
   my($ptr) = \%siemens_hdr;
   $Data::Dumper::Deepcopy = 1;
   print STDOUT Dumper(\$ptr);
   }

# Read in ASCCONV header slice positions and normals (and fill in the blanks!)
foreach (@{$siemens_hdr{sSliceArray}{asSlice}}){
   
   # fill in "missing" (default?) co-ordinates.
   if(!defined($_->{sPosition}{dSag})){
      $_->{sPosition}{dSag} = 0;
      print "Completed position for slice in Sag\n" if $opt{verbose};
      }
   if(!defined($_->{sPosition}{dCor})){
      $_->{sPosition}{dCor} = 0;
      print "Completed position for slice in Cor\n" if $opt{verbose};
      }
   if(!defined($_->{sPosition}{dTra})){
      $_->{sPosition}{dTra} = 0;
      print "Completed position for slice in Tra\n" if $opt{verbose};
      }
   
   # Damn LPS and Radiological vs Neurological Stupidity!
   $_->{sPosition}{dSag} *= -1;
   $_->{sPosition}{dCor} *= -1;
   
   push(@slice_pos, [$_->{sPosition}{dSag}, 
                     $_->{sPosition}{dCor},
                     $_->{sPosition}{dTra}]);
   
   # fill in "missing" (default?) normals.
   if(!defined($_->{sNormal}{dSag})){
      $_->{sNormal}{dSag} = 0;
      print "Completed normal for Sag\n" if $opt{verbose};
      }
   if(!defined($_->{sNormal}{dCor})){
      $_->{sNormal}{dCor} = 0;
      print "Completed normal for Cor\n" if $opt{verbose};
      }
   if(!defined($_->{sNormal}{dTra})){
      $_->{sNormal}{dTra} = 0;
      print "Completed normal for Tra\n" if $opt{verbose};
      }
   
   push(@slice_nrm, [$_->{sNormal}{dSag}, 
                     $_->{sNormal}{dCor}, 
                     $_->{sNormal}{dTra}]);
   }

# convert the image data using dicom_to_minc
my($conv_fn);
print STDOUT " +++ Converting using dicom_to_minc: \n" if !$opt{quiet};
&do_cmd('dicom3_to_minc', $tmpdir, $infile);
chomp($conv_fn = `ls -1 $tmpdir/*.mnc`);
print STDOUT " +++ Found file $conv_fn\n" if !$opt{quiet};

# get the file dimension order
my($code);
chomp($buf = `mincinfo -dimnames $conv_fn`);
$buf =~ s/\ $//;
($dimnames[2], $dimnames[1], $dimnames[0]) = split(/\ /, $buf, 3);
for($i=0; $i<3; $i++){
   $code = substr($dimnames[$i], 0, 1);
   $dimcodes[$i] = $code;
   if($code eq 'x'){
      $dim_idx[$i] = 0;
      }
   elsif($code eq 'y'){
      $dim_idx[$i] = 1;
      }
   elsif($code eq 'z'){
      $dim_idx[$i] = 2;
      }
   }
print STDOUT "Dimension order: @dimnames - (@dimcodes)\n" if $opt{verbose};

# get the tile size
my(@tile_size, $ntiles);
# $tile_size[0] = $siemens_hdr{sKSpace}{lPhaseEncodingLines};
$tile_size[0] = $siemens_hdr{sKSpace}{lImagesPerSlab};
$tile_size[1] = $siemens_hdr{sKSpace}{lBaseResolution};

# check for interpolation
if(defined($siemens_hdr{sKSpace}{uc2DInterpolation}) && 
   $siemens_hdr{sKSpace}{uc2DInterpolation} == 1){
   $tile_size[0] *= 2;
   $tile_size[1] *= 2;
   }

# number of tiles
$ntiles = $siemens_hdr{sSliceArray}{lSize};
if($ntiles == 1){
   warn "$me: This is not a mosaic, (sSliceArray.lSize == $ntiles) simply moving the file should do\n";
   &do_cmd('mv', $conv_fn, $outfile);
   exit(0);
   }

# get the mosaic size
my(@mosaic_size, @concat_files);
chomp($mosaic_size[0] = `mincinfo -dimlength $dimnames[0] $conv_fn`);
chomp($mosaic_size[1] = `mincinfo -dimlength $dimnames[1] $conv_fn`);

# extract the mosaic tiles
print STDOUT " +++ Extracting Mosaic tiles ($tile_size[0] x $tile_size[1])" .
             " from ($mosaic_size[0] x $mosaic_size[1]): " if !$opt{quiet};
$n = 0;
for($j=0; $j<$mosaic_size[1]; $j += $tile_size[1]){
   for($i=0; $i<$mosaic_size[0]; $i += $tile_size[0]){
      
      my($tmpfile) = sprintf("$tmpdir/slice_%05d.mnc", $n);
      &do_cmd('mincreshape', '-quiet', '-clobber',
              '-dimrange', "$dimnames[0]=$i,$tile_size[0]",
              '-dimrange', "$dimnames[1]=$j,$tile_size[1]",
              '-dimrange', "$dimnames[2]=0,0",
              $conv_fn, $tmpfile);
      
      push(@concat_files, $tmpfile);
      $n++;
      print STDOUT "." if !$opt{quiet};
      
      # stop after $ntiles
      if($n >= $ntiles){
         last;
         }
      }
   
   # stop after $ntiles
   if($n >= $ntiles){
      last;
      }
   }
print STDOUT "Done. ($n Frames)\n" if !$opt{quiet};

# put them back together in the correct order...
# currently broken until I get some docco from siemens
push(@{$gen_hdr->{files}}, $concat_files[0]);
foreach (@{$siemens_hdr{sSliceArray}{anAsc}}){
   if(defined($_)){
      push(@{$gen_hdr->{files}}, $concat_files[$_]);
      }
   }
   

# get sizes
$gen_hdr->{"$dimcodes[0]size"} = $tile_size[0];
$gen_hdr->{"$dimcodes[1]size"} = $tile_size[1];
$gen_hdr->{"$dimcodes[2]size"} = $ntiles;


# in-plane steps
$gen_hdr->{"$dimcodes[0]step"} = $siemens_hdr{sSliceArray}{asSlice}[0]{dPhaseFOV} / 
                                 $gen_hdr->{"$dimcodes[0]size"};
$gen_hdr->{"$dimcodes[1]step"} = $siemens_hdr{sSliceArray}{asSlice}[0]{dReadoutFOV} / 
                                 $gen_hdr->{"$dimcodes[1]size"};

# for inter-slice gap (z in axial) in mosaics let's assume 
# the gap between the first two slices is indicitive
#$gen_hdr->{"$dimcodes[2]step"} = sqrt(($slice_pos[0][0] - $slice_pos[1][0])**2 +
#                                      ($slice_pos[0][1] - $slice_pos[1][1])**2 +
#                                      ($slice_pos[0][2] - $slice_pos[1][2])**2);

# assume first slice thickness is indicitive
$gen_hdr->{"$dimcodes[2]step"} = $siemens_hdr{sSliceArray}{asSlice}[0]{dThickness};

# add slice gap if defined
if(defined($siemens_hdr{sGroupArray}{asGroup}[0]{dDistFact})){
   $gen_hdr->{"$dimcodes[2]step"} *= 1 + $siemens_hdr{sGroupArray}{asGroup}[0]{dDistFact};
   }

# flipping step _SHOULD_ be here (for out of plane step)

# check against the ASCCONV header
$args = "mincinfo -attvalue $dimnames[0]:step ".
                 "-attvalue $dimnames[1]:step $conv_fn";
my(@steps) = split(' ', `$args`);
if(($steps[0] != $gen_hdr->{xstep}) ||
   ($steps[1] != $gen_hdr->{ystep})){
   warn "\n$me: ASCCONV slice steps (" .
        $gen_hdr->{"$dimcodes[0]step"} . ':' . 
        $gen_hdr->{"$dimcodes[1]step"} . ') != '.
        "Header from minc file ($steps[0]:$steps[1])\n\n";

   $gen_hdr->{"$dimcodes[0]step"} = $steps[0];
   $gen_hdr->{"$dimcodes[1]step"} = $steps[1];
  }


# as dicom_to_minc has already extracted these, simply read in the direction cosines
$gen_hdr->{xdircos} = [split(' ', `mincinfo -attvalue xspace:direction_cosines $conv_fn`)];
$gen_hdr->{ydircos} = [split(' ', `mincinfo -attvalue yspace:direction_cosines $conv_fn`)];
$gen_hdr->{zdircos} = [split(' ', `mincinfo -attvalue zspace:direction_cosines $conv_fn`)];

# check slice norm against the ASCCONV header
my($delta) = 0.0000001;
if((abs($slice_nrm[0][0]) - abs($gen_hdr->{"$dimcodes[2]dircos"}[0]) > $delta) ||
   (abs($slice_nrm[0][1]) - abs($gen_hdr->{"$dimcodes[2]dircos"}[1]) > $delta) ||
   (abs($slice_nrm[0][2]) - abs($gen_hdr->{"$dimcodes[2]dircos"}[2]) > $delta)){
  warn "\n$me: ASCCONV normal (" . join(' ', @{$slice_nrm[0]}) . ")\n             " .
       "             != DICOM (" . join(' ', @{$gen_hdr->{"$dimcodes[2]dircos"}}) . ")\n\n";
  }


# calculate origin
my(@origin, $scale, @tmp);
for $i (0..2){
   $origin[$i] = $slice_pos[0][$i];
   }
   
# transpose tile dimensions to origin
# origin = slice_position - half FOV + 1/2 step for "tile dimensions"
for $i (0..1){
   $scale = -($gen_hdr->{"$dimcodes[$i]size"}/2 * $gen_hdr->{"$dimcodes[$i]step"}) +
            ($gen_hdr->{"$dimcodes[$i]step"}/2);
   @tmp = &vector_scale($scale, $gen_hdr->{"$dimcodes[$i]dircos"});
   
   # add to the current origin
   @origin = &vector_add(\@origin, \@tmp);
   }
for $i (0..2){
   $gen_hdr->{origin}[$i] = $origin[$i];
   }

($gen_hdr->{xstart}, $gen_hdr->{ystart}, $gen_hdr->{zstart}) 
    = &convert_origin_to_start($gen_hdr->{origin}, 
                               $gen_hdr->{xdircos},
                               $gen_hdr->{ydircos},
                               $gen_hdr->{zdircos});

print STDOUT dump_general_header($gen_hdr) if $opt{verbose};

print STDOUT " +++ Creating 3D image ($dimnames[2]): " if !$opt{quiet};
&do_cmd('mincconcat', '-clobber', 
        '-nocheck_dimensions', 
        '-step', $gen_hdr->{"$dimcodes[2]step"},
        '-start', $gen_hdr->{"$dimcodes[2]start"},
        '-concat_dimension', $dimnames[2],
        @{$gen_hdr->{files}}, $outfile);        

# dodgy hack to ascertain out of slice step direction (and flip it)
# THIS MUST BE DONE after mincconcat as it is too clever for it's own good
if($slice_pos[0][$dim_idx[2]] > $slice_pos[1][$dim_idx[2]]){
   $gen_hdr->{"$dimcodes[2]step"} *= -1;
   print STDOUT "$dim_idx[2] - Flipped step in $dimcodes[2] - " . $gen_hdr->{"$dimcodes[2]step"} . "\n";
   }

# insert correct start/step/dircos and add the history string
&do_cmd('minc_modify_header', 
        '-dinsert', "xspace:start=$gen_hdr->{xstart}",
        '-dinsert', "yspace:start=$gen_hdr->{ystart}",
        '-dinsert', "zspace:start=$gen_hdr->{zstart}",
        
        '-dinsert', "xspace:step=$gen_hdr->{xstep}",
        '-dinsert', "yspace:step=$gen_hdr->{ystep}",
        '-dinsert', "zspace:step=$gen_hdr->{zstep}",
        
        '-dinsert', "xspace:direction_cosines=" . join(',', @{$gen_hdr->{xdircos}}),
        '-dinsert', "yspace:direction_cosines=" . join(',', @{$gen_hdr->{ydircos}}),
        '-dinsert', "zspace:direction_cosines=" . join(',', @{$gen_hdr->{zdircos}}),
        
        '-sinsert', ":history=$history", $outfile);

# add ASCCONV header to MINC header
#foreach  (sort(keys(%siemens_hdr))){
#   push(@args, '-sinsert', "siemens_header:$_=" . Dumper($siemens_hdr{$_}));
#   }
#&do_cmd('minc_modify_header', @args, $outfile);


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

# return a ASCII dump of a general header
sub dump_general_header{
   my($h) = shift;
   my($tmp);
   
   $tmp = "General Header\n";
   foreach (sort(keys(%{$h}))){
      if($h->{$_} =~ /ARRAY/){
         $tmp .= " $_\t<". join(' ' , @{$h->{$_}}) . ">\n";
         }
      else{
         $tmp .= " $_\t<$h->{$_}>\n";
         }
      }
   $tmp .= "\n";
      
   return $tmp;
   }

# Routine to compute a dot product from two arrayrefs
sub vector_dot_product {
   my($vec1, $vec2) = @_;
   my($result, $i);
   $result = 0;
   for $i (0..2) {
       $result += $$vec1[$i] * $$vec2[$i];
   }
   return $result;
   }

# Routine to compute a vector cross product from two arrayrefs
sub vector_cross_product {
   my($vec1, $vec2) = @_;
   my(@result);
   $#result = 2;
   $result[0] = $$vec1[1] * $$vec2[2] - $$vec1[2] * $$vec2[1];
   $result[1] = $$vec1[2] * $$vec2[0] - $$vec1[0] * $$vec2[2];
   $result[2] = $$vec1[0] * $$vec2[1] - $$vec1[1] * $$vec2[0];
   return @result;
   }

# Routine to add two vectors
sub vector_add {
   my($vec1, $vec2) = @_;
   my(@result, $i);
   $#result = 2;
   for $i (0..2) {
      $result[$i] = $$vec1[$i] + $$vec2[$i];
      }
   return @result;
   }

# Routine to scale a vector
sub vector_scale {
   my($scale, $vec1) = @_;
   my(@result, $i);
   $#result = 2;
   for $i (0..2) {
      $result[$i] = $$vec1[$i] * $scale;
      }
   return @result;
   }


# Routine to convert an origin specified in world coordinates
#    to an array of minc start positions by projecting the
#    point along the edges of the parallelopiped formed by the
#    3 direction cosines. Direction cosines are normalized.
# This is converted from convert_origin_to_start.c in the base
#   minc package
sub convert_origin_to_start {
   my($origin, $xdircos, $ydircos, $zdircos) = @_;
   my(@axes, @normal, @lengths, $normal_length, $numerator, $denominator);
   my(@start);
   $#start = 2;

   # Set up dircos matrix
   for $i (0..2){
      $axes[0][$i] = $$xdircos[$i];
      $axes[1][$i] = $$ydircos[$i];
      $axes[2][$i] = $$zdircos[$i];
      }

   # Calculate lengths of direction cosines, 
   # checking for zero lengths and parallel vectors.
   for $i (0..2){
      
      @normal = &calculate_orthogonal_vector($axes[$i], $axes[($i+1) % 3]);
      
      $lengths[$i] = 0.0;
      $normal_length = 0.0;
      for $j (0..2) {
         $lengths[$i] += $axes[$i][$j] ** 2;
         $normal_length += $normal[$j] ** 2;
         }
      $lengths[$i] = sqrt($lengths[$i]);
      
      # sanity checks
      if($lengths[$i] == 0.0) {
         die "$me: Cannot convert origin to start - some direction cosines have zero length.\n";
         }
      if($normal_length == 0.0) {
         die "$me: Cannot convert origin to start - some direction cosines are parallel.\n";
         }
      }

   # Loop over axes, calculating projections
   for $i (0..2) {

      # Calculate vector normal to other two axes by doing cross product
      @normal = &calculate_orthogonal_vector($axes[($i+1) % 3], $axes[($i+2) % 3]);

      # Calculate dot product of origin with normal (numerator) and
      # dot product of current axis with normal (denominator)
      $denominator = $numerator = 0.0;
      for $j (0..2) {
         $numerator += $$origin[$j] * $normal[$j];
         $denominator += $axes[$i][$j] * $normal[$j];
         }

      # Calculate parallel projection
      if($denominator != 0.0){
         $start[$i] = $lengths[$i] * $numerator / $denominator;
         }
      else{
         $start[$i] = 0.0;
         }
      }

   return @start;
   }


# Routine to calculate a vector that is orthogonal to 2 other
# vectors by doing a cross product. The vectors are copied
# before the calculation so the result vector can be one of
# the input vectors.
sub calculate_orthogonal_vector {
   my($vec1, $vec2) = @_;
   my(@result);
   $#result = 2;
   
   for $i (0..2) {
      $result[$i] = 
         $$vec1[($i+1) % 3] * $$vec2[($i+2) % 3] -
         $$vec2[($i+1) % 3] * $$vec1[($i+2) % 3];
      }
   return @result;
   }

sub print_version_info {
   my($package, $version, $package_bugreport);

   $package = '@PACKAGE@';
#   $version = '@VERSION@';
   $version = $VERSION;
   $package_bugreport = '@PACKAGE_BUGREPORT@';

   print STDOUT "\n$package version $version\n".
                "Comments to $package_bugreport\n\n";
   exit;
   }

__END__

# POD time
=pod

=head1 NAME

siemens_mosaic2mnc - perl script to convert a single siemens DICOM mosaic file (.IMA) 
to a MINC file preserving coordinate information

=head1 SYNOPSIS

   siemens_mosaic2mnc [options] <in_mosaic.IMA> <outfile.mnc>
   siemens_mosaic2mnc -help

=head1 PREREQUISITES

This script requires the <Getopt::Tabular> module.

=head1 AUTHOR

Andrew Janke E<lt>a.janke@gmail.comE<gt>

=head1 SEE ALSO

dicom3_to_minc(1).

=head1 COPYRIGHT
 
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 of Queensland make no representations about the
suitability of this software for any purpose.  It is provided "as is" 
without express or implied warranty.

=cut
