############################################################################
# tkregister.tcl: UCSD/UCL tkregister user interface (tcl/tk) -- Marty Sereno
############################################################################
### recent changes
# adjust tk/gl startup, fix a few redraw bindings
# simplify swap: rm record_swapbuffer/updateflag, tkregister manages buffers
# now incompat w/FreeSurfer0.8 tkregister.tcl -> mkdefs links to swap between
# continuous redraw on slider movement, blinktime left of TARGET above COMPARE
# blurflag under SAGMIRR
# invertmoveflag blurflag
# add SEND/GOTO button to inside of TRANSLATE panel of mini
# fix arrow key bindings for fmov (up,down) and tkwin slice move (left,right)
# added 11 R-click help panels
# raise window on plane change
# add toggle save tiff
# ---- csurfsrc-140113.tgz ----
# rm unnecessary back slashes in curly brace -command args and cmd logic
# omit top line of unused (POP GL, READENV) widgets in F3 interface
# new F3 tick report/override roundregflag read from register.dat, squish
# remove interprocess tcl send from SENT PNT
# popup warn change round policy
# movedown/uncover gl window w/interface size change
# add F3 help panels, including "round"
# double click anywhere on tk window raises gl window (replace rm'd POP GL butt)
# showvisible after every 'set overlay blah' to update TARGET/MOVEABLE buttons
# match new tkregsiter.c name: $session->$isession (incl's "image")
# if round policy change accepted, update roundregorigflag
# ----- csurfsrc-150220.tgz ------
# bigger (28->36) Linux putbelowtkwin gap for interface size change at startup
# ----- csurfsrc-150425.tgz ------
# update to new trace syntax
# ----- csurfsrc-150912.tgz ------
# respect new helpfile name: fthresh -> fthresh2
# ----- csurfsrc-151010.tgz ------
# small upper left "h" button for tkregister help
# ----- csurfsrc-160130.tgz ------
# ----- csurfsrc-160411.tgz ------
# ----- csurfsrc-160527.tgz ------
# ----- csurfsrc-160624.tgz ------
# ----- csurfsrc-161004.tgz ------
# ----- csurfsrc-161217.tgz ------
# ----- csurfsrc-170320.tgz ------
# ----- csurfsrc-170621.tgz ------
# ----- csurfsrc-171018.tgz ------
# ----- csurfsrc-180125.tgz ------
# ----- csurfsrc-180621.tgz ------
# fix typo: showvisble
# ----- csurfsrc-190208.tgz ------
# ----- csurfsrc-191216.tgz ------
# ----- csurfsrc-200629.tgz ------
# ----- csurfsrc-210614.tgz ------
# ----- csurfsrc-220324.tgz ------
# ----- csurfsrc-221002.tgz ------ (14i)

#TODO: block focussed-on-scale default Up/Down key bindings (change fmov only)


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

### so script can determine who called it
set interfacefile tkregister.tcl
set tkregistertcl_version 14j

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

### slider sizing
set sclenx 140
set scleny 120

### linked tkregister vars set at startup
#str: home isession subject registerdat analysedat subjtmpdir movformat rgb
#dbl: fsquash fthresh fscale_2
#flg: blinkflag editedmatrix maskflag promptflag followglwinflag blurflag
#     invertmoveflag doublebufferflag tiffoutflag roundregflag roundregorigflag
#int: zf xdim ydim imnr1 plane imc ic jc overlay blinkdelay blinktime glxdepth

### literal file list,subdirs for setfile
set rgbdir rgb
set rgbfiles { rgb }

### others
set zrot 0.0
set xtrans 0.0
set ytrans 0.0
set xscale 100.0
set yscale 100.0
set zscale 100.0
set dxtrans 0.25   ;# orig 0.5, tried 0.1 -> irritating
set dytrans 0.25

### slice (slider!) limits
set cormax [expr $imnr1-1]
set cormin 0
set sagmax [expr $xdim/$zf-1]
set sagmin 0
set hormax [expr $ydim/$zf-1]
set hormin 0
set newimc 127
set newic 127
set newjc 127
set dontzoom 0

### slice planes
set cor 0
set hor 1
set sag 2

### overlay
set target 1
set moveable 2

### events
set userok 0
set blinkflag 0
set initdelay $blinkdelay

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

############################################################################
proc setfile { varName value } {    ;# csurf glob
  upvar $varName localvar
  upvar ${varName}abbrev localabbrev
  global home isession subject              ;# setfile rgb ~/tmp/myrgb
  global rgbdir
  global rgbfiles 
  ## set subdir using name of var and premade lists
  if { [lsearch -exact $rgbfiles $varName] >= 0 } {
    set subdir $rgbdir
  } else {
    puts "bad arg: don't know how to set file type: $varName"
    puts "  setfile {$rgbfiles} 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] != "/" } {
      puts "tkregister: can't reset subject home dir without restarting"
      prompt
      return
    }
    if { [string length $value] < 3 } {
      puts "tkregister: no filename specified for setfile"
      prompt
      return
    }
    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
  } else {  ;# relative (guess session vs. subjects)
    if { $subdir == "." } {
      set fullname $isession/$value
    } else {
      set fullname $isession/$subdir/$value
    }
  }
  set localvar $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 resettransform { } {
  global zrot xtrans ytrans xscale yscale zscale
  set zrot 0.0
  set xtrans 0.0; set ytrans 0.0
  set xscale 100.0; set yscale 100.0; set zscale 100
}

#proc fixfocus { varName index op } { }  ;# save example old syntax
proc fixfocus { name1 name2 op } {
  global plane cor hor sag
  if {$plane==$cor} { focus .view.cor.bot.sc }
  if {$plane==$hor} { focus .view.hor.bot.sc }
  if {$plane==$sag} { focus .view.sag.bot.sc }
}

proc zoomcoords { name1 name2 op } {  ;# trace nice, update real if changed
  global zf newimc newic newjc imc ic jc
  global dontzoom
  if {$dontzoom} { return }
  set imc [expr $newimc*$zf]
  set ic [expr $newic*$zf]
  set jc [expr $newjc*$zf]
}

proc unzoomcoords { plane } {  ;# update nice (stop loop)
  global zf newimc newic newjc imc ic jc
  global cor hor sag dontzoom
  set dontzoom 1
  set newimc [expr $imc/$zf]
  set newic [expr $ic/$zf]
  set newjc [expr $jc/$zf]
  set dontzoom 0
}

proc changeslice { dir plane } {
  global zf newimc newic newjc imc ic jc
  global cor hor sag
  if {$dir == "up"} { upslice }
  if {$dir == "down"} { downslice }
  if {$plane==$cor} { set newimc [expr $imc/$zf] }
  if {$plane==$hor} { set newic [expr $ic/$zf] }
  if {$plane==$sag} { set newjc [expr $jc/$zf] }
}

proc rotepi { angle } {
  global plane cor hor sag
  if {$plane==$cor} { rotate_brain_y [expr $angle*10.0] }
  if {$plane==$hor} { rotate_brain_z [expr -$angle*10.0] }
  if {$plane==$sag} { rotate_brain_x [expr $angle*10.0] }
}

proc transepi { dist axis } {
  global plane cor hor sag
  if {$axis=="x"} {
    if {$plane==$cor} { translate_brain_x [expr -$dist] }
    if {$plane==$hor} { translate_brain_x [expr -$dist] }
    if {$plane==$sag} { translate_brain_y $dist }
  }
  if {$axis=="y"} {
    if {$plane==$cor} { translate_brain_z $dist }
    if {$plane==$hor} { translate_brain_y $dist }
    if {$plane==$sag} { translate_brain_z $dist }
  }
}

proc scaleepi { factor axis } {
  global plane cor hor sag
  if {$axis=="x"} {
    if {$plane==$cor} { scale_brain_x [expr 100.0/$factor] }
    if {$plane==$hor} { scale_brain_x [expr 100.0/$factor] }
    if {$plane==$sag} { scale_brain_y [expr 100.0/$factor] }
  }
  if {$axis=="y"} {
    if {$plane==$cor} { scale_brain_z [expr 100.0/$factor] }
    if {$plane==$hor} { scale_brain_y [expr 100.0/$factor] }
    if {$plane==$sag} { scale_brain_z [expr 100.0/$factor] }
  }
}

proc showvisible { } {
  global overlay target moveable
  if {$overlay == $target} {
    .mid.buff.mid.aTARGET.bu config -relief sunken
    .mid.buff.mid.aMOVEABLE.bu config -relief raised
  }
  if {$overlay == $moveable} {
    .mid.buff.mid.aTARGET.bu config -relief raised
    .mid.buff.mid.aMOVEABLE.bu config -relief sunken
  }
}

proc findsendto { } {
  global fulltksurfer
  set fulltksurfer ""
  catch { set fulltksurfer [lrange [exec ps -af | grep /tksurfer] 7 7] }
}

proc check_write_reg { } {
  global registerdat roundregflag roundregorigflag

  if {$roundregflag != $roundregorigflag} {
    if {$roundregflag} {
      set change "truncate (older) -> round"
      set butlabel "Save As Round (new)"
    } else {
      set change "round -> truncate (older)"
      set butlabel "Save As Truncate (old)"
    }
    if ![okreplace "" \
       "OK to change rounding policy in\
        \nregister.dat from:\n\n    ${change}?" "${butlabel}"] {
      confirmalert "Register transform file:\n\n    $registerdat\n\nnot touched"
      return
    } else {
      write_reg
      set roundregorigflag $roundregflag
    }
  } else { testreplace $registerdat write_reg }
}

proc testclose { } {   ;# called from wrappers.tcl, intercept in C event loop
  global editedmatrix env registerdat
  if {$editedmatrix} {
    set resp [okclose $registerdat]
    if {$resp > 1} {write_reg}
    if {$resp > 0} {exit}
  } else {
    destroy .
    exit        ;# takes GLX window with it
  }
}

proc macro { } {  ;# restore old default
  global tkregisterinterface
  #pack .head -before .view   ;# omit rarely used top row
  pack .view.main -before .view.cor -fill x
  pack .view.vals.left -before .view.vals.right -side left
  pack .mid -before .xform -side left
  pack .mid.buff.top -before .mid.buff.mid
  pack forget .mid.buff.mid.e
  pack forget ".mid.buff.bot.aSAVE REG" .xform.tran.bot.la.ext
  pack forget .view.vals.bus
  pack forget .mid.scal.bot.la.aSAGMIRR
  .mid.buff.bot.aCOMPARE.bu config -pady 2 -padx 11
  pack .mid.buff.bot.aALIGN
  pack .mid.rgb -before .mid.buff
  pack .mid.scal -before .mid.rgb
  pack .xform.bot -after .xform.rot
  pack .xform.rot.bot -after .xform.rot.top
  set tkregisterinterface macro
  putbelowtkwin
}

proc mini { } {
  global tkregisterinterface ffontbb
  pack .view.vals.left -before .view.vals.right -side left
  pack .mid -before .xform -side left
  pack .mid.buff.top -before .mid.buff.mid
  pack .mid.buff.mid.e -before .mid.buff.mid.aTARGET -side left -padx 1
  pack .mid.scal -before .mid.buff -fill x
  pack .xform.tran.bot.la.ext
  pack forget .head .view.main .mid.rgb .xform.bot .mid.buff.top .xform.rot.bot
  pack forget .mid.buff.bot.aALIGN
  pack forget .view.vals.bus
  .mid.buff.bot.aCOMPARE.bu config -pady 3 -padx 4
  pack ".mid.buff.bot.aSAVE REG" -after .mid.buff.bot.aCOMPARE
  pack .mid.scal.bot.la.aSAGMIRR
  set tkregisterinterface mini
  putbelowtkwin
}

proc micro { } {
  global tkregisterinterface ffontbb
  pack forget .head .view.main .mid .xform.bot .mid.buff.top .xform.rot.bot
  pack forget .mid.scal .view.vals.left .xform.tran.bot.la.ext
  .mid.buff.bot.aCOMPARE.bu config -pady 3 -padx 4
  pack .view.vals.bus
  pack .xform.rot.bot -after .xform.rot.top
  set tkregisterinterface micro
  putbelowtkwin
}

proc mkalternates { } {
  global ffontbb ffontb sfont
  ### for mini
  set f .mid.buff.bot
  buttons $f "SAVE REG" { check_write_reg } row 3 3
  "$f.aSAVE REG.bu" config -font $ffontbb
  pack forget ".mid.buff.bot.aSAVE REG"
  set f [frame .xform.tran.bot.la.ext]
  pack $f -side top
  frame $f.sp  ;# -height 55 (was empty)
  pack $f.sp -side top
  frame $f.sp.top -height 10
  pack $f.sp.top -side top
  ### removed interprocess send from SENT PNT
  buttons $f.sp "SEND PNT" {
    write_point
    #findsendto
    #catch { send $fulltksurfer select_orig_vertex_coordinates }
  } col 1 5
  buttons $f.sp "GOTO PNT" { goto_point; redraw; unzoomcoords $plane } col 1 5
  frame $f.sp.bot -height 10
  pack $f.sp.bot -side top
  edlabval $f "zrot" 0 n 0 5
  $f.zrot.e config -textvariable zrot -font $sfont
  $f.zrot.la config -font $sfont
  ### for micro
  set f [frame .view.vals.bus]
  pack $f -side left
  buttons $f "SAVE REG" { check_write_reg } col 2 6
  "$f.aSAVE REG.bu" config -font $ffontb
  buttons $f "COMPARE" { } col 3 12
  $f.aCOMPARE.bu config -font $ffontbb
  bind $f.aCOMPARE.bu <ButtonPress-1> { swapoverlay; set blinkflag 1 }
  bind $f.aCOMPARE.bu <ButtonRelease-1> \
    { set blinkflag 0; set blinkdelay $initdelay; showvisible }
  bind $f.aCOMPARE.bu <ButtonRelease-3> { helpwin compare }
  pack forget .view.vals.bus
}

proc putaboveglwin { gl_winx gl_winy } {  ;# called from X11 mv glx event
  set geo [wm geometry .]
  set beg [expr [string first x $geo] + 1]
  set end [expr [string first + $geo] - 1]
  set tkysize [string range $geo $beg $end]
  set tkx $gl_winx
  set tky [expr $gl_winy - $tkysize]
  wm geometry . +${tkx}+${tky}
}

proc putbelowtkwin { } {  ;# F1/F2/F3 interface size change
  global glwinx glwiny
  update idletasks   ;# if wm has blocked winmove past top, mk it finish
  set geo [wm geometry .]
  set beg [expr [string first x $geo] + 1]
  set end [expr [string first + $geo] - 1]
  set tkysize [string range $geo $beg $end]
  set beg [expr [string last + $geo] + 1]
  set tkypos [string range $geo $beg end]
  if {$tkypos < 0} { set tkypos 0 }   ;# if above top (before wm blocks)
  recordglwinxy   ;# C func: to glwinx,glwiny
  set gap 28
  if {[exec uname] == "Linux"} { set gap 36 }
  move_window $glwinx [expr $tkypos + $tkysize + $gap] ;#N.B. mv trigs putabove
}

############################################################################
wm title . "tkregister ([file tail $movformat] => $subject)"
wm geometry . +670+23    ;# +122+762, 504x350+122+762, +670+23
wm protocol . WM_DELETE_WINDOW testclose
wm resizable . 0 0

frame .head
pack .head -side top
  frame .head.pop
  pack .head.pop -side left
  frame .head.title
  pack .head.title -side left
  frame .head.env
  pack .head.env -side left

frame .view -borderwidth 1
pack .view -side left -anchor n
  # main
  frame .view.main -borderwidth 2 -relief groove
  pack .view.main -side top -fill x
    frame .view.main.reg
    pack .view.main.reg -side top
    frame .view.main.pnt
    pack .view.main.pnt -side top
  # three identical slice panels
  foreach v { cor sag hor } {
    frame .view.$v -borderwidth 2 -relief groove
    pack .view.$v -side top -fill x
      frame .view.$v.top
      pack .view.$v.top -side top
      frame .view.$v.bot
      pack .view.$v.bot -side top
  }
  # misc entries
  frame .view.vals
  pack .view.vals -side top
    frame .view.vals.left
    pack .view.vals.left -side left
    frame .view.vals.right
    pack .view.vals.right -side left

frame .mid -borderwidth 1
pack .mid -side left -anchor n
  # scale panel
  frame .mid.scal -borderwidth 2 -relief groove
  pack .mid.scal -side top -fill x
    frame .mid.scal.top
    pack .mid.scal.top -side top
    frame .mid.scal.bot
    pack .mid.scal.bot -side top
      frame .mid.scal.bot.la
      pack .mid.scal.bot.la -side right -anchor center
  # save rgb
  frame .mid.rgb -borderwidth 2 -relief groove
  pack .mid.rgb -side top -fill x
  # buffers
  frame .mid.buff -borderwidth 2 -relief groove
  pack .mid.buff -side top -fill x
    frame .mid.buff.top
    pack .mid.buff.top -side top
    frame .mid.buff.mid -borderwidth 1
    pack .mid.buff.mid -side top
    frame .mid.buff.bot
    pack .mid.buff.bot -side top

frame .xform -borderwidth 1
pack .xform -side left -anchor n
  # translate panel
  frame .xform.tran -borderwidth 2 -relief groove
  pack .xform.tran -side top
    frame .xform.tran.top
    frame .xform.tran.bot
    pack .xform.tran.top -side top 
    pack .xform.tran.bot -side top
      frame .xform.tran.bot.la
      pack .xform.tran.bot.la -side right -anchor center
  # rotate panel
  frame .xform.rot -borderwidth 2 -relief groove
  pack .xform.rot -side top
      frame .xform.rot.top
      pack .xform.rot.top -side top
      frame .xform.rot.bot -borderwidth 0  ;# squish: was 2
      pack .xform.rot.bot -side top -anchor center
  # last few
  frame .xform.bot -borderwidth 2
  pack .xform.bot -side top
    frame .xform.bot.a
    pack .xform.bot.a -side top
    frame .xform.bot.b
    pack .xform.bot.b -side top

############################################################################
### title 
set f .head.pop
buttons $f "POP GL" { raise_window } row 0 5
set f .head.title
edlabval $f "scan" $isession n 6 44
$f.scan.e config -font $ffontb -state disabled
$f.scan.e xview end
set f .head.env
buttons $f READENV {source $env(CSURF_DIR)/lib/tcl/readenv.tcl; redraw} col 0 5

## main save panel
# save,read reg
set f .view.main.reg
buttons $f "SAVE REG" { check_write_reg } row 4 5
"$f.aSAVE REG.bu" config -font $ffontbb
buttons $f "READ REG" {
  read_reg
  set overlay $moveable
  showvisible
  redraw
} row 2 5
# goto, save point
set f .view.main.pnt
buttons $f "SEND PNT" {
  write_point
  #findsendto
  #catch { send $fulltksurfer select_orig_vertex_coordinates }
} row 2 5
buttons $f "GOTO PNT" { goto_point; redraw; unzoomcoords $plane } row 2 5

### cor: button (suppress mode change after possible swap)
set f .view.cor.top
button $f.bu -text "h" -font $ffontb -pady 2 -padx 0 -command {
  helpwin $env(CSURF_DIR)/lib/help/csurf/tkregister
}
pack $f.bu -side left -padx 0
buttons $f CORONAL {raise_window;set plane $cor;redraw;unzoomcoords $cor} row
edlabval $f "slice" 0 n 6 3
$f.slice.e config -textvariable newimc -font $sfont
bind $f.slice.e <Return> {set plane $cor; redraw; update idletasks}
### cor: slice
set f .view.cor.bot
scale $f.sc -from $cormin -to $cormax -length $sclenx -variable newimc \
   -orient horizontal -tickinterval 127 -showvalue false -font $sfont \
   -width 11 -resolution 1
pack $f.sc -side top
bind $f.sc <ButtonRelease-1> {set plane $cor; redraw; update idletasks}
bind $f.sc <B1-Motion> { redraw }
### sag: button
set f .view.sag.top
buttons $f SAGITTAL {raise_window;set plane $sag;redraw;unzoomcoords $sag} row
edlabval $f "slice" 0 n 6 3
$f.slice.e config -textvariable newjc -font $sfont
bind $f.slice.e <Return> {set plane $sag; redraw; update idletasks}
### sag: slice
set f .view.sag.bot
scale $f.sc -from $sagmin -to $sagmax -length $sclenx -variable newjc \
   -orient horizontal -tickinterval 127 -showvalue false -font $sfont \
   -width 11 -resolution 1
pack $f.sc -side top
bind $f.sc <ButtonRelease-1> {set plane $sag; redraw; update idletasks}
bind $f.sc <B1-Motion> { redraw }
### hor: button
set f .view.hor.top
buttons $f HORIZONTAL {raise_window;set plane $hor;redraw;unzoomcoords $hor} row
edlabval $f "slice" 0 n 6 3
$f.slice.e config -textvariable newic -font $sfont
bind $f.slice.e <Return> {set plane $hor; redraw; update idletasks}
### hor: slice
set f .view.hor.bot
scale $f.sc -from $hormin -to $hormax -length $sclenx -variable newic \
   -orient horizontal -tickinterval 127 -showvalue false -font $sfont \
   -width 11 -resolution 1
pack $f.sc -side top
bind $f.sc <ButtonRelease-1> {set plane $hor; redraw; update idletasks}
bind $f.sc <B1-Motion> { redraw }

### make plane focus explicit
#trace variable plane w fixfocus  ;# saved example old syntax
trace add variable plane write fixfocus

### fix slice num on var update
trace add variable newimc write zoomcoords
trace add variable newic write zoomcoords
trace add variable newjc write zoomcoords

### misc entries
# left
set f .view.vals.left
edlabval $f "contrast" 0 n 9 4
$f.contrast.e config -textvariable fsquash
bind $f.contrast.e <Return> { set_scale; redraw }
edlabval $f "midpoint" 0 n 9 4
$f.midpoint.e config -textvariable fthresh
bind $f.midpoint.e <Return> { set_scale; redraw }
# right
set f .view.vals.right
edlabval $f "fmov" 0 n 5 4
$f.fmov.e config -textvariable fscale_2
bind $f.fmov.e <Return> {
  set_scale
  set overlay $moveable
  showvisible
  redraw
}
checks $f "" "masktarg" maskflag col
$f.amasktarg.ck config -command { redraw }

### scale epi ###
# title and horiz scale
set f .mid.scal.top
label $f.la -text "SCALE BRAIN (percent)" -font $ffontb -pady 0
pack $f.la -side top
scale $f.x -from 90 -to 110 -length $sclenx -variable xscale \
   -orient horizontal -tickinterval 20 -showvalue false -font $sfont \
   -width 11 -resolution 0.5
pack $f.x -side top
bind $f.x <ButtonRelease-1> { scaleepi $xscale x; resettransform; \
                              set overlay $moveable; showvisible; redraw }
# vertical scale
set f .mid.scal.bot
scale $f.y -from 110 -to 90 -length $scleny -variable yscale \
   -orient vertical -tickinterval 20 -showvalue false -font $sfont \
   -width 11 -resolution 0.5
pack $f.y -side left
bind $f.y <ButtonRelease-1> { scaleepi $yscale y; resettransform; \
                              set overlay $moveable; showvisible; redraw }
# entries
set f .mid.scal.bot.la
edlabval $f "x" 0 n 2 6
edlabval $f "y" 0 n 2 6
$f.x.e config -textvariable xscale -font $sfont
$f.y.e config -textvariable yscale -font $sfont
$f.x.la config -font $sfont
$f.y.la config -font $sfont
bind $f.x.e <Return> { scaleepi $xscale x; resettransform; \
                       set overlay $moveable; showvisible; redraw }
bind $f.y.e <Return> { scaleepi $yscale y; resettransform; \
                       set overlay $moveable; showvisible; redraw }
# 2009: add mini interface SAGMIRR button inside scalepanel (was in macro only)
frame $f.sp -height 15
pack $f.sp -side top
buttons $f "SAGMIRR" {
  mirror_brain
  set overlay $moveable
  showvisible
  redraw
} col 1 7
checks $f "" "blurmov" blurflag col          ;# 2010
checks $f "" "invertmov" invertmoveflag col  ;# 2010
$f.ablurmov.ck config -command { redraw }
$f.ainvertmov.ck config -command { redraw }

### save rgb button,field
set f .mid.rgb
setfile rgb $rgb  ;# make abbrev
#edlabval $f  "nm"   $rgb   n 3 19
#$f.nm.e config -textvariable rgbabbrev
entry $f.e -font $ffont -width 22 -textvariable rgbabbrev
$f.e config -selectbackground green -insertbackground black
pack $f.e -side top -fill x
buttons $f "SAVE BITMAP" { setfile rgb [.mid.rgb.e get]; \
                           testreplace $rgb save_rgb } row 1
checkbutton $f.ck -variable tiffoutflag -font $ffont -text tiff -command {
  if {$tiffoutflag} {
    setfile rgb [file rootname [.mid.rgb.e get]].tiff
  } else {
    setfile rgb [file rootname [.mid.rgb.e get]].rgb
  }
}
pack $f.ck -side left -padx 0

### load buffers panel
# select
set f .mid.buff.top
label $f.title -text "Set Front Buffer" -font $ffont -pady 0
pack $f.title -side top
set f .mid.buff.mid
entry $f.e -textvariable blinktime -width 3
pack $f.e -side left -padx 2
buttons $f "TARGET" { set overlay $target; showvisible; redraw } row 1 7
buttons $f "MOVEABLE" { set overlay $moveable; showvisible; redraw } row 1 7
#bind $f.aTARGET.bu <ButtonRelease-1> {
#  after 100 {
#    .mid.buff.mid.aTARGET.bu config -relief sunken
#    .mid.buff.mid.aMOVEABLE.bu config -relief raised
#  }
#}
#bind $f.aMOVEABLE.bu <ButtonRelease-1> {
#  after 100 {
#    .mid.buff.mid.aTARGET.bu config -relief raised
#    .mid.buff.mid.aMOVEABLE.bu config -relief sunken
#  }
#}

# compare/blink
set f .mid.buff.bot
buttons $f "COMPARE" { } row 2
$f.aCOMPARE.bu config -font $ffontbb
bind $f.aCOMPARE.bu <ButtonPress-1> { swapoverlay; set blinkflag 1 } 
bind $f.aCOMPARE.bu <ButtonRelease-1> { \
    set blinkflag 0; set blinkdelay $initdelay; showvisible }
buttons $f "ALIGN" {
  align_points
  set overlay $moveable
  showvisible
  redraw
} row 2 5
$f.aALIGN.bu config -font $ffontbb

### translate epi ###
# title and horiz scale
set f .xform.tran.top
label $f.la -text "TRANSLATE BRAIN (mm)" -font $ffontb -pady 0
pack $f.la -side top
scale $f.x -from 25 -to -25 -length $sclenx -variable xtrans \
   -orient horizontal -tickinterval 25 -showvalue false -font $sfont \
   -width 11 -resolution $dxtrans
pack $f.x -side top
bind $f.x <ButtonRelease-1> { transepi $xtrans x; resettransform; \
                              set overlay $moveable; showvisible; redraw }
# vertical scale
set f .xform.tran.bot
scale $f.y -from -25 -to 25 -length $scleny -variable ytrans \
   -orient vertical -tickinterval 25 -showvalue false -font $sfont \
   -width 11 -resolution $dytrans
pack $f.y -side left
bind $f.y <ButtonRelease-1> { transepi $ytrans y; resettransform; \
                              set overlay $moveable; showvisible; redraw }
# entries
set f .xform.tran.bot.la
edlabval $f "x" 0 n 2 6
edlabval $f "y" 0 n 2 6
$f.x.e config -textvariable xtrans -font $sfont
$f.y.e config -textvariable ytrans -font $sfont
$f.x.la config -font $sfont
$f.y.la config -font $sfont
bind $f.x.e <Return> { transepi $xtrans x; resettransform; \
                       set overlay $moveable; showvisible; redraw }
bind $f.y.e <Return> { transepi $ytrans y; resettransform; \
                       set overlay $moveable; showvisible; redraw }

### rotate epi ###
set f .xform.rot.top
label $f.title -text "   ROTATE BRAIN (deg)   " -font $ffontb -pady 0
pack $f.title -side top
scale $f.z -from -30 -to 30 -length $sclenx -variable zrot \
    -orient horizontal -tickinterval 30 -showvalue false -font $sfont \
    -width 11 -resolution 0.2
pack $f.z -side top -pady 0
bind $f.z <ButtonRelease-1> { rotepi $zrot; resettransform; \
                              set overlay $moveable; showvisible; redraw }
# entry
set f .xform.rot.bot
edlabval $f "zrot" 0 n 5 5
$f.zrot.e config -textvariable zrot -font $sfont
$f.zrot.la config -font $sfont
bind $f.zrot.e <Return> { rotepi $zrot; resettransform; \
                          set overlay $moveable; showvisible; redraw }

### sagittal mirror
set f .xform.bot.a
buttons $f "SAGMIRR" {
  mirror_brain
  set overlay $moveable
  showvisible
  redraw
} row 0

### blinktime
set f .xform.bot.b
checkbutton $f.ck -variable roundregflag -font $ffont -text round \
  -command { set overlay $moveable; showvisible; redraw }
pack $f.ck -side left -padx 0
edlabval $f "blinktime" 0 n 9 3
$f.blinktime.e config -textvariable blinktime

### for mini,micro
mkalternates

### update slice num's, etc
unzoomcoords $cor
unzoomcoords $sag
unzoomcoords $hor
set plane $cor
showvisible

############################################################################
### shortcut key bindings -- find 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)
# interface size
bind . <F1> { micro }  ;# requires fn-F? on Mac
bind . <F2> { mini }
bind . <F3> { macro }
# slices: slice changed by default arrowkey bindings for scale (Alt or no-Alt)
bind . <Right> { redraw }
bind . <Left>  { redraw }
# EPI brightness (TODO: block default arrowkey binding for scale)
bind . <Up>   {set overlay $moveable;set fscale_2 [expr $fscale_2 * 1.2];redraw}
bind . <Down> {set overlay $moveable;set fscale_2 [expr $fscale_2 / 1.2];redraw}

## key combos: alt/cmd + key (modifiers not required in glx window)
# COMPARE button
bind . <$xcmd-0> { swapoverlay }
# target contrast/brightness
bind . <$xcmd-asterisk> { \
  set overlay $target
  showvisible
  set fsquash [expr $fsquash * 1.1]
  set_scale
  redraw
}
bind . <$xcmd-slash> {
  set overlay $target
  showvisible
  set fsquash [expr $fsquash / 1.1]
  set_scale
  redraw
}
bind . <$xcmd-plus>  {
  set overlay $target
  showvisible
  set fthresh [expr $fthresh - 0.05]
  set_scale
  redraw
}
bind . <$xcmd-equal>  {
  set overlay $target
  showvisible
  set fthresh [expr $fthresh - 0.05]
  set_scale
  redraw
}
bind . <$xcmd-minus> {
  set overlay $target
  showvisible
  set fthresh [expr $fthresh + 0.05]
  set_scale
  redraw
}
bind . <$xcmd-r> { \
  set overlay $target
  showvisible
  set fthresh 0.35
  set fsquash 12.0
  set_scale
  redraw
}
# blur
bind . <$xcmd-b> { set blurflag [expr !$blurflag]; redraw }
# invert
bind . <$xcmd-i> { set invertmoveflag [expr !$invertmoveflag]; redraw }
# SEND/GOTO
bind . <$xcmd-f> { ".xform.tran.bot.la.ext.sp.aSEND PNT.bu" invoke }
bind . <$xcmd-g> { ".xform.tran.bot.la.ext.sp.aGOTO PNT.bu" invoke }

## replace removed POP GL button
bind . <Double-Button-1> { raise_window }

############################################################################
### right-click help
bind ".view.main.reg.aSAVE REG.bu" <ButtonRelease-3> { helpwin savereg }
bind ".view.main.reg.aREAD REG.bu" <ButtonRelease-3> { helpwin readreg }
bind ".view.main.pnt.aSEND PNT.bu" <ButtonRelease-3> { helpwin sendpnt }
bind ".view.main.pnt.aGOTO PNT.bu" <ButtonRelease-3> { helpwin gotopnt }
bind .view.vals.left.contrast.e <ButtonRelease-3> { helpwin fsquash }
bind .view.vals.left.midpoint.e <ButtonRelease-3> { helpwin fthresh2 }
bind .view.vals.right.fmov.e <ButtonRelease-3> { helpwin fmov }
bind .view.vals.right.amasktarg.ck <ButtonRelease-3> { helpwin masktarg }
bind ".view.vals.bus.aSAVE REG.bu" <ButtonRelease-3> { helpwin savereg }
bind .mid.scal.bot.la.aSAGMIRR.bu <ButtonRelease-3> { helpwin sagmirr }
bind .mid.scal.bot.la.ablurmov.ck <ButtonRelease-3> { helpwin blurmov }
bind .mid.scal.bot.la.ainvertmov.ck <ButtonRelease-3> { helpwin invertmov }
bind .mid.buff.mid.e <ButtonRelease-3> { helpwin blinktime }
bind .mid.buff.mid.aTARGET.bu <ButtonRelease-3> { helpwin target }
bind .mid.buff.mid.aMOVEABLE.bu <ButtonRelease-3> { helpwin moveable }
bind .mid.buff.bot.aALIGN.bu <ButtonRelease-3> { helpwin align }
bind .mid.buff.bot.aCOMPARE.bu <ButtonRelease-3> { helpwin compare }
bind ".mid.buff.bot.aSAVE REG.bu" <ButtonRelease-3> { helpwin savereg }
bind \
 ".xform.tran.bot.la.ext.sp.aSEND PNT.bu" <ButtonRelease-3> { helpwin sendpnt }
bind \
 ".xform.tran.bot.la.ext.sp.aGOTO PNT.bu" <ButtonRelease-3> { helpwin gotopnt }
bind .xform.bot.a.aSAGMIRR.bu <ButtonRelease-3> { helpwin sagmirr }
bind .xform.bot.b.ck <ButtonRelease-3> { helpwin round }
bind .xform.bot.b.blinktime.e <ButtonRelease-3> { helpwin blinktime }

############################################################################
puts "tkregister.tcl: startup done"

fixcolors
if [info exists env(tkregisterinterface)] {
  if {$env(tkregisterinterface) == "macro"} { macro }
  if {$env(tkregisterinterface) == "mini"}  { mini }
} else {
  mini
  puts "tkregister.tcl: default mini interface (to change: macro,mini,micro)"
  puts "tkregister.tcl: or: setenv tkregisterinterface {macro,mini,micro}"
}

