#! /bin/sh
# (next line not seen by tcl) \
exec tclsh $0 ${1+"$@"}    # goto tcl, wherever it is

### forceMSB: marty sereno -- force AFNI BRIK to MSB byte order
# 1998 -- 01a: initial hack
# 2012 -- 01d: more types, better which

### alternate 3rd line: but breaks standalone
#DYLD_LIBRARY_PATH=$CSURF_LIBRARY_PATH exec tclsh $0 ${1+"$@"}  # goto my tcl

### test if can make or overwrite a file
proc canwriteormakefile { path } {
  if [file exists $path] {
    if { [file isfile $path] && [file writable $path] } {
      return 1
    } else { return 0 }
  } else { 
    set parent [file dirname $path]
    if { [file isdirectory $parent] && [file writable $parent] } {
      return 1
    } else { return 0 }
  }
}

### binary found on path (N.B.: tcsh/bash aliases *not* followed)
proc foundbywhich { somebinary } {
  catch {eval exec /usr/bin/which $somebinary} ret
  # (1) MacOSX,Debian, (2,3) RedHat,Fedora (error reports tail), (4) older
  if { [string match "" $ret] ||
       [string match "*no $somebinary*" $ret] ||
       [string match "*no [file tail $somebinary]*" $ret] ||
       [string match "*child process exited abnormally*" $ret] } {
    return 0
  } else {
    return 1
  }
}

### get BRICK_TYPES: byte,short,int,float,double,complex,unrecnum,err=empty
proc readheadbriktypes { header } {  ;# Cox says try not to mix types in brik
  set id [open $header r]
  set lines [split [read $id] \n]
  close $id
  set i 0
  set typecodelist ""
  foreach line $lines {
    if [string match *BRICK_TYPES* $line] { set i 2; continue }
    if { $i == 2 } { set i 1; set count [lindex $line 2]; continue }
    if { $i == 1 } {
      set typecodelist "$typecodelist $line"
      if { [llength $typecodelist] < $count } { continue }
      set i 0
    }
  }
  set typelist ""
  foreach typecode $typecodelist {
    set type $typecode
    if {$typecode == 0} { set type byte }
    if {$typecode == 1} { set type short }
    if {$typecode == 2} { set type int }
    if {$typecode == 3} { set type float }
    if {$typecode == 4} { set type double }
    if {$typecode == 5} { set type complex }
    if {$typecode == 6} { set type rgb }
    set typelist "$typelist $type"
  }
  return $typelist
}

### force brik to MSB byteorder, fix HEAD for binary compat
proc forcebrikMSBfirst { brikstem } {
  set inhead $brikstem.HEAD
  set inbrik $brikstem.BRIK
  set idinhead [open $inhead r]
  set lines [split [read $idinhead] \n]
  close $idinhead
  set tmphead /tmp/TmpAfniHead.[pid]
  if { [catch {set idtmphead [open $tmphead w 0644]}] } { return }
  set checkhead ok
  foreach line $lines {
    if { [lindex $line 0] == "'LSB_FIRST~" } {
      puts $idtmphead "'MSB_FIRST~"
      set checkhead swap
    } else {
      puts $idtmphead $line
    }
  }
  close $idtmphead   ;# TODO: extra CR appended
  if {$checkhead == "swap"} {
    if { ![canwriteormakefile $inhead] || ![canwriteormakefile $inbrik] } {
      puts "forceMSB: ### $inhead is LSBfirst but permissions prevent swap"
    } else {
      set briktypes [readheadbriktypes $inhead]
      if {$briktypes != ""} {
        set firsttype [lindex $briktypes 0]
        foreach type $briktypes {
          if { $type != $firsttype } {
            confirmalert \
       "forceMSB: ### BRICK_TYPES not all same:\n\n$briktypes\n\n...can't swap"
            return
          }
        }
      } else { set firsttype short }  ;# like AFNI: no BRICK_TYPES assumed short
      if { $firsttype == "short" } {
        set swapper 2swap
      } elseif { $firsttype == "float" } {
        set swapper 4swap
      } else {
        confirmalert "forceMSB: ### can't swap this BRIK type: $firsttype"
        return
      }
      exec $swapper -q $inbrik  ;# composite path OK
      exec mv -f $tmphead $inhead
     puts "forceMSB: ($firsttype) $inbrik byteorder now MSBfirst (Sun/IRIX/Mac)"
    }
  } else {
    set firsttype [lindex [readheadbriktypes $inhead] 0]
    puts "forceMSB: ### ($firsttype) $inhead already MSBfirst  ...not swapped"
  }
  exec rm -f $tmphead
}

### help
if {$argc != 1} {
  puts \
    "\nuse: forceMSB <brik>    \[force csurf/freesurfer byteorder, fix HEAD\]\n"
  return
}
set brik [lindex $argv 0]

### check args, files, binaries
if { [file extension $brik] != ".BRIK"} {
  puts "forceMSB: ### no .BRIK suffix on infile: $brik"
  return
}
set brikstem [file rootname $brik]
set inbrik $brikstem.BRIK
if ![file exists $inbrik] {
  puts "forceMSB: ### $inbrik not found"
  return
}
set inhead $brikstem.HEAD
if ![file exists $inhead] {
  puts "forceMSB: ### $inhead not found"
  return
}
foreach bin { 2swap 4swap } {
  if ![foundbywhich $bin] {
    puts "forceMSB: ### couldn't find binary: $bin on \$path"
    return
  }
}

### go
forcebrikMSBfirst $brikstem 

