############################################################################
# tkstrip.tcl: UCSD/UCL tkstrip user interface (tcl/tk) -- Marty Sereno
############################################################################
### recent changes
# tk8.5, fixcolors, rm pop/sess line, add more parms, squish
# redefine abs_imstem_in/out (=b/mfname): .../T1/COR- -> .../T1 (or .mgz)
# RESET resets all parms to defaults
# squish: mv MODES up/left entries, shorten entries, rename updates, bg SHRINK
# expose shrinkmode, MODES->ACTION
# rearrange/update setfile, change abs_imstem_{in,out} to {in,out}im
# cmd-arrowkeys in interface window
# ---- csurfsrc-140113.tgz ----
# rm unnecessary back slashes in curly brace -command args and cmd logic
# rm canwriteormake (now in wrappers.tcl)
# ---- csurfsrc-160130.tgz ----
# add upper-left "h" button

### block direct run
if ![info exists peeledflag] {  ;# tkstrip.c-defined unlikely there bare run
  puts "tkstrip.tcl: ### tk interface: designed to be loaded by tkstrip binary"
  exit
}

### so script can determine who called it
set interfacefile tkstrip.tcl

### restore old look
if { $tcl_version == "8.5" } {
  puts "tksurfer.tcl: restore old look"
  ::tk::classic::restore
}

### linked tkstrip string C-vars init'd at startup
# $home $isession $subject $datfile $insurf $outsurf
# $shrinkmode

### slider sizing
set sclenx 135
set scleny 102

### literal subdirs for setfile expansions
set mridir mri
set surfdir surf
set scriptsdir scripts
set bemdir bem
set rgbdir rgb
set datdir .

### variable-name lists for setfile globbing
set mrifiles { inim outim maskim }
set surffiles { outsurf }
set scriptsfiles { script }
set bemfiles { insurf }
set rgbfiles { rgb }
set datfiles { datfile }

### events
set userok 0

### shrink steps/reps
set shrinksteps  1   ;# redraw every $shrinksteps
set repsteps    60   ;# total cycles of $shrinksteps

### normal dist move
set normaldist 0.5

### myshrinkmode's
set brain    1
set inskull  2
set outskull 3
set outskin  4

### editimgtype
set noimage -1
set cordir   0
set mghfile  1
set mgzfile  2

### tcl defaults
set myshrinkmode $brain

### source standard widget wrapper code (fonts/colors/popups)
set program tkstrip    ;# find helpfiles
source $env(CSURF_DIR)/lib/tcl/wrappers.tcl

############################################################################
### tcl 'set' plus csurf-specific glob/expand and re-abbreviate
proc setfile { varName value } {  ;# makes "varName"abbrev if it doesn't exist
  upvar $varName localvar
  upvar ${varName}abbrev localabbrev    ;# setfile rgb ~/tmp/myrgb
  global home subject isession
  global mridir surfdir scriptsdir bemdir rgbdir datdir
  global mrifiles surffiles scriptsfiles bemfiles rgbfiles datfiles
  global env
  ### set subdir using name of var and premade lists
  if       { [lsearch -exact $mrifiles $varName] >= 0 } {
    set subdir $mridir
  } elseif { [lsearch -exact $surffiles $varName] >= 0 } {
    set subdir $surfdir
  } elseif { [lsearch -exact $scriptsfiles $varName] >= 0 } {
    set subdir $scriptsdir
  } elseif { [lsearch -exact $bemfiles $varName] >= 0 } {
    set subdir $bemdir
  } elseif { [lsearch -exact $rgbfiles $varName] >= 0 } {
    set subdir $rgbdir
  } elseif { [lsearch -exact $datfiles $varName] >= 0 } {
    set subdir $datdir
  } else {
    puts "bad arg: don't know how to set file type: $varName"
    puts "  setfile {$mrifiles} value"
    puts "  setfile {$surffiles} value"
    puts "  setfile {$scriptsfiles} value"
    puts "  setfile {$bemfiles} value"
    puts "  setfile {$rgbfiles} value"
    puts "  setfile {$datfiles} value"
    prompt
    return
  }
  ### do expansions and make fullname
  if { [string range $value 0 0] == "/"} {
    set fullname $value
  } elseif { [string range $value 0 0] == "~"} {
    if { [string length $value] > 1 && [string range $value 1 1] != "/" } {
      set tildegone [string range $value 1 end]
      set fullname $home/$tildegone    ;# other subject
    } else {
      set tildegone [string range $value 2 end]
      set subdir [file dirname $tildegone]      ;# overwrite, may be multilevel
      set filename [file tail $tildegone]
      if { $subdir == "." } {
        set fullname $home/$subject/$filename
      } else {
        set fullname $home/$subject/$subdir/$filename
      }
    }
  } elseif { [string range $value 0 0] == "*"} {
    set stargone [string range $value 2 end]
    set fullname $isession/$stargone
  } elseif { [string range $value 0 0] == "@"} { ;# at=libbem
    set atgone [string range $value 2 end]
    set fullname $env(CSURF_DIR)/lib/bem/$atgone
  } elseif { [string range $value 0 0] == "#"} { ;# pound=libscript
    set poundgone [string range $value 2 end]
    set fullname $env(CSURF_DIR)/lib/tcl/$poundgone
  } else {  ;# relative (guess session vs. subjects,bemlib)
    if { $subdir == "." } {
      set fullname $isession/$value
    } else {
      set fullname $isession/$subdir/$value
    }
  }
  set localvar $fullname
  #puts $fullname

  ### attempt to re-abbrev (first ~, then *, else set absolute)
  set homename $home/$subject
  set homelen [string length $homename]
  set endhome [incr homelen -1]
  set begintail [incr homelen 1]
  if { $homename == [string range $fullname 0 $endhome] } {
    set localabbrev ~[string range $fullname $begintail end]
    return
  }
  set sessionlen [string length $isession]
  set endsession [incr sessionlen -1]
  set begintail [incr sessionlen 1]
  if { $isession == [string range $fullname 0 $endsession] } {
    set localabbrev *[string range $fullname $begintail end]
    return
  }
  set localabbrev $fullname
}

proc redrawbutton { } {
  global xrot yrot zrot
  rotate_brain_x $xrot
  rotate_brain_y $yrot
  rotate_brain_z $zrot
  redraw
  set xrot 0; set yrot 0; set zrot 0
}

proc shrinkbutton { } {
  global shrinksteps repssteps
  for {set i 0} {$i < $repssteps} {incr i} {
    shrink $shrinksteps
    update
    #update idletasks
    redraw
  }
}

proc initparms { } {
  global myshrinkmode brain inskull outskull outskin
  global fzero fmax dfrac istilt
  global MRIflag momentumflag flattenflag
  global fsteepness fstrength update decay
  global outsurf datfile outim
  global editimgtype mghfile mgzfile

  set MRIflag 1
  set momentumflag 1
  set flattenflag 0
  set fsteepness 0.5
  set fstrength 1.0
  set update 0.9
  set decay 0.9
  if {$myshrinkmode == $brain} { 
    set fzero 45
    set fmax 120
    set dfrac 0.7
    set istilt 1.0
    # uplevel for correct setfile upvar scope
    uplevel {setfile outsurf ~/bem/brain.tri}
    uplevel {setfile datfile ~/scripts/brain.dat}
    if { $editimgtype == $mghfile || $editimgtype == $mgzfile } {
      uplevel {setfile outim ~/mri/brain.mgz}
    } else {
      uplevel {setfile outim ~/mri/brain}
    }
  }
  if {$myshrinkmode == $inskull} {
    set fzero 20
    set fmax 100
    set dfrac 1.1
    set istilt 4.0
    uplevel {setfile outsurf ~/bem/inner_skull.tri}
    uplevel {setfile datfile ~/scripts/inner_skull.dat}
    if { $editimgtype == $mghfile || $editimgtype == $mgzfile } {
      uplevel {setfile outim ~/mri/tmp.mgz }
    } else {
      uplevel {setfile outim ~/mri/tmp }
    }
  }
  if {$myshrinkmode == $outskull} {
    set fzero 40
    set fmax 255
    set dfrac 1.5
    set istilt 5.0
    uplevel {setfile outsurf ~/bem/outer_skull.tri}
    uplevel {setfile datfile ~/scripts/outer_skull.dat}
    if { $editimgtype == $mghfile || $editimgtype == $mgzfile } {
      uplevel {setfile outim ~/mri/tmp.mgz}
    } else {
      uplevel {setfile outim ~/mri/tmp}
    }
  }
  if {$myshrinkmode == $outskin} {
    set fzero 40
    set fmax 255
    set dfrac 1.2
    set istilt 3.0
    uplevel {setfile outsurf ~/bem/outer_skin.tri}
    uplevel {setfile datfile ~/scripts/outer_skin.dat}
    if { $editimgtype == $mghfile || $editimgtype == $mgzfile } {
      uplevel {setfile outim ~/mri/tmp.mgz}
    } else {
      uplevel {setfile outim ~/mri/tmp}
    }
  }
}

proc test_write_images { } {
  global outim editimgtype mghfile mgzfile cordir

  if { $editimgtype == $cordir && ![file exists $outim] } {
    if [canwriteormakefile $outim] {
      if ![okreplace $outim \
            "OK to create COR dir:\n\n    $outim?" "Create dir"] {
        confirmalert " COR dir:\n\n    $outim\n\n\
                       not created\n\n COR images not written"
        return
      }
      exec mkdir $outim
    } else {
      confirmalert "permissions prevent creating COR dir:\n\n   $outim"
      return
    }
  }

  if { $editimgtype == $mghfile || $editimgtype == $mgzfile } {
    set imfile $outim
  } else {
    set imfile $outim/COR-001
  }
  testreplace $imfile write_images
}

proc setshrinkmode { } {
  global myshrinkmode shrinkmode
  global brain inskull outskull outskin
  if {$myshrinkmode == $brain}    { set shrinkmode 1 }
  if {$myshrinkmode == $inskull}  { set shrinkmode 4 }
  if {$myshrinkmode == $outskull} { set shrinkmode 3 }
  if {$myshrinkmode == $outskin}  { set shrinkmode 4 }
  puts "tkstrip.tcl: shrinkmode = $shrinkmode"
  prompt
}

proc testclose { } {
  if {0} {   ;# C editedflag
    set resp [okclose somefile]
    if {$resp > 1} {      }
    if {$resp > 0} { exit }
  } else {
    destroy .
    exit
  }
}

############################################################################
### startup
wm title . "tkstrip (${subject}: shrinkvol=[file tail $inim])"
wm protocol . WM_DELETE_WINDOW testclose
wm resizable . 0 0
wm geometry . +658+564  ;# reduce upper right flash

frame .head
pack .head -side top

frame .left -borderwidth 1
pack .left -side left

  frame .left.action -borderwidth 2 -relief groove
  pack .left.action -side top -fill x

  frame .left.rotate -borderwidth 2 -relief groove
  pack .left.rotate -side top -fill x
    frame .left.rotate.top
    pack .left.rotate.top -side top
    frame .left.rotate.bot
    pack .left.rotate.bot -side top
      frame .left.rotate.bot.la
      pack .left.rotate.bot.la -side right -anchor center

  frame .left.move -borderwidth 2 -relief groove
  pack .left.move -side top -fill x
    frame .left.move.norm
    pack .left.move.norm -side top
    frame .left.move.init
    pack .left.move.init -side top

frame .right -borderwidth 1
pack .right -side left

  frame .right.top -borderwidth 2 -relief groove
  pack .right.top -side top -fill x

    frame .right.top.mode -borderwidth 2 -relief groove
    pack .right.top.mode -side left -fill y
    frame .right.top.files -borderwidth 2 -relief groove
    pack .right.top.files -side left -fill x

  frame .right.bot -borderwidth 1
  pack .right.bot -side top

    frame .right.bot.cmp ;# -borderwidth 1
    pack .right.bot.cmp -side left
      frame .right.bot.cmp.shrink -borderwidth 0 ;# -relief groove
      pack .right.bot.cmp.shrink -side top -fill x
        frame .right.bot.cmp.shrink.left
        pack .right.bot.cmp.shrink.left -side left
        frame .right.bot.cmp.shrink.right
        pack .right.bot.cmp.shrink.right -side left
      frame .right.bot.cmp.mid -borderwidth 1
      pack .right.bot.cmp.mid -side top
        frame .right.bot.cmp.mid.parm -borderwidth 2 -relief groove
        pack .right.bot.cmp.mid.parm -side left
        frame .right.bot.cmp.mid.parm2 -borderwidth 2 -relief groove
        pack .right.bot.cmp.mid.parm2 -side left
        frame .right.bot.cmp.mid.flags -borderwidth 2 -relief groove
        pack .right.bot.cmp.mid.flags -side left

############################################################################
### title
#set f .head
#buttons $f "POP GL" { winpop } row 0 5
#edlabval $f "session(*)" [exec pwd] n 11 47
#$f.session(*).e config -font $ffontb -state disabled
#$f.session(*).e xview moveto 1.0

### action panel (save, peel)
set f .left.action
button $f.bu -text "h" -font $ffontb -pady 1 -padx 0 -command {
  helpwin $env(CSURF_DIR)/lib/help/csurf/tkstrip
}
pack $f.bu -side left -padx 0
buttons $f "SAVEIMGS" { \
  setfile outim [.right.top.files.outmri.e get]; test_write_images } row 0 2
$f.aSAVEIMGS.bu config -text "SAVE IMGS" -font $ffontbb
buttons $f "PEEL" { peel_brain } row 0 1

### rotate panel: label
set f .left.rotate.top
label $f.la -text "ROTATE (deg)" -font $ffontb -pady 0
pack $f.la -side top
## horiz
scale $f.y -from 180 -to -180 -length $sclenx -variable yrot \
  -orient horizontal -tickinterval 90 -showvalue false -font $sfont -width 11
pack $f.y -side top
bind $f.y <B1-ButtonRelease> { redrawbutton }
## vertical
set f .left.rotate.bot
scale $f.x -from 180 -to -180 -length $scleny -variable xrot \
  -orient vertical -tickinterval 90 -showvalue false -font $sfont -width 11
pack $f.x -side left ;# -anchor e
bind $f.x <B1-ButtonRelease> { redrawbutton }
## restore, entries
set f .left.rotate.bot.la
checks $f "" "smoothdisp" smoothflag col
$f.asmoothdisp.ck config -command redraw
buttons $f "RESTORE" { restore } col 0 5
edlabval $f "yrot" 0 n 5 4
edlabval $f "xrot" 0 n 5 4
#label $f.space -text "" -font $sfont  ;# a little space
#pack $f.space -side top
edlabval $f "zrot" 0 n 5 4
$f.yrot.e config -textvariable yrot -font $sfont
$f.xrot.e config -textvariable xrot -font $sfont
$f.zrot.e config -textvariable zrot -font $sfont
$f.yrot.la config -font $sfont
$f.xrot.la config -font $sfont
$f.zrot.la config -font $sfont
bind $f.xrot.e <Return> { redrawbutton }
bind $f.yrot.e <Return> { redrawbutton }
bind $f.zrot.e <Return> { redrawbutton }

set f .left.move.norm
buttons $f "NORM MOVE" { move_vertices $normaldist; redraw } row 0 2
edlabval $f "mm" $normaldist n 3 3
$f.mm.e config -textvariable normaldist
set f .left.move.init
buttons $f "SCALE SURF TO MRI" { init_surf_to_image; redraw } col 0 5

### files
set f .right.top.files
## set abbrev vars to startup values
setfile insurf $insurf
setfile outsurf $outsurf
#setfile datfile $datfile
setfile inim $inim
setfile outim $outim
setfile rgb $rgb
## setup entries
edlabval $f "insurf"    $insurfabbrev   r   6 14
edlabval $f "inmri"     $inimabbrev     r   6 14
#edlabval $f "datfile"   $datfileabbrev  rw  6 14
edlabval $f "outsurf"   $outsurfabbrev   w  6 14
edlabval $f "outmri"    $outimabbrev     w  6 14
edlabval $f "rgb"       $rgbabbrev       w  4 17
## show abbrevs in entries
$f.insurf.e config -textvariable insurfabbrev
$f.outsurf.e config -textvariable outsurfabbrev
#$f.datfile.e config -textvariable datfileabbrev 
$f.inmri.e config -textvariable inimabbrev
$f.outmri.e config -textvariable outimabbrev
$f.rgb.e config -textvariable rgbabbrev
## config read/write muttons
$f.insurf.br config -padx 1 -command {
  setfile insurf [.right.top.files.insurf.e get]
  read_geometry
  .right.top.files.insurf.e xview moveto 1.0
  redraw
}
$f.outsurf.bw config -padx 1 -command {
  setfile outsurf [.right.top.files.outsurf.e get]
  testreplace $outsurf write_geometry
}
$f.inmri.br config -padx 1 -command {
  setfile inim [.right.top.files.inmri.e get]
  read_images
  redraw
}
$f.outmri.bw config -padx 1 -command {
  setfile outim [.right.top.files.outmri.e get]
  test_write_images
}
#$f.datfile.br config -padx 1 -command {
#  setfile datfile [.right.top.files.datfile.e get]
#  read_datfile
#}
#$f.datfile.bw config -padx 1 -command {
#  setfile datfile [.right.top.files.datfile.e get]
#  testreplace $datfile write_datfile
#}
$f.rgb.bw config -padx 1 -command {
  setfile rgb [.right.top.files.rgb.e get]
  testreplace $rgb save_rgb
}
.right.top.files.insurf.e xview moveto 1.0

### mode field
set f .right.top.mode
label $f.la -text "ACTION" -font $ffontb -pady 1
pack $f.la -side top
radios $f  ""  "brain"    myshrinkmode  $brain    7  col
radios $f  ""  "inskull"  myshrinkmode  $inskull  7  col
radios $f  ""  "outskull" myshrinkmode  $outskull 7  col
radios $f  ""  "outskin"  myshrinkmode  $outskin  7  col
$f.abrain.ra config -command    { setshrinkmode; initparms; set MRIflag 1 }
$f.ainskull.ra config -command  { setshrinkmode; initparms; set MRIflag 1 }
$f.aoutskull.ra config -command { setshrinkmode; initparms; set MRIflag 1 }
$f.aoutskin.ra config -command  { setshrinkmode; initparms; set MRIflag 1 }
edlabval $f "smode" $shrinkmode n 5 2
$f.smode.e config -textvariable shrinkmode
$f.smode.la config -text "smode"

### shrink
set f .right.bot.cmp.shrink.left
buttons $f SHRINK { shrinkbutton } row 1 2
$f.aSHRINK.bu config -font $ffontbb
set f .right.bot.cmp.shrink.right
edlabval $f "steps/update" $shrinksteps  n 11 4 row
$f.steps/update.e config -textvariable shrinksteps
edlabval $f "updates" $repsteps  n 7 5 row
$f.updates.e config -textvariable repssteps

### shrink parms
#xxxxxxx
set f .right.bot.cmp.mid.parm
edlabval $f "fzero"  $fzero      n 5 4
edlabval $f "fmax"   $fmax       n 5 4
edlabval $f "dfrac"  $dfrac      n 5 4
edlabval $f "istilt" $istilt     n 5 4
$f.fzero.e config -textvariable fzero
$f.fmax.e config -textvariable fmax
$f.dfrac.e config -textvariable dfrac
$f.istilt.e config -textvariable istilt
set f .right.bot.cmp.mid.parm2
edlabval $f "fsteep"    $fsteepness n 8 4
edlabval $f "fstrength" $fstrength  n 8 4
edlabval $f "update"    $update     n 8 4
edlabval $f "decay"     $decay      n 8 4
$f.fsteep.e config -textvariable fsteepness
$f.fstrength.e config -textvariable fstrength
$f.update.e config -textvariable update
$f.decay.e config -textvariable decay

### flags
set f .right.bot.cmp.mid.flags
checks $f "" "MRIflag"      MRIflag          col
checks $f "" "momentum"     momentumflag     col
checks $f "" "flatten"      flattenflag      col
checks $f "" "intersection" intersectionflag col

############################################################################
### shortcut key bindings ( keysyms: bind . <KeyPress> { puts %K } )
# Mac noeffect/reserved:  a,c,h,m,n,q,v,w,x,z
# Mac useable:  b,d,e,f,g,i,j,k,l,o,p,r,s,t,u,y,-,+,*,/

## plain keys (N.B.: plain letter keys will get typed into entries)
#TODO

## key combos: alt/cmd + key
# rotate brain (require cmd key in interface window)
bind . <$xcmd-Up>    { rotate_brain_x  2.0; redraw }
bind . <$xcmd-Down>  { rotate_brain_x -2.0; redraw }
bind . <$xcmd-Right> { rotate_brain_y -2.0; redraw }
bind . <$xcmd-Left>  { rotate_brain_y  2.0; redraw }

############################################################################
### right-click help -- TODO
#bind .draw.main.aREDRAW.bu <B3-ButtonRelease> { helpwin redraw }

############################################################################
puts "tkstrip.tcl: startup done"
fixcolors

