#---------------------------------------------------------------------------
# In order to run a triple axis spectrometer, SICS has to be made to behave
# like the ancient MAD program from ILL. Some of the MAD commands had to 
# be implemented in C (see tas*.c) but others can be implemented in Tcl.
# This file contains the procedures and command definitions for this syntax
# adaption from SICS to MAD. 
#
# Mark Koennecke, December 2000, March 2001, April 2002
#--------------------------------------------------------------------------


#-------------------------------------------------------------------------
# Perform initialization, but only on first go

if { [info exists tasinit] == 0 } {
  set tasinit 1
  SicsAlias fileeval do User
  Publish ou User
  Publish out User
  Publish fi User
  SicsAlias fi fix User
  Publish cl User
  SicsAlias cl clear
  Publish co User
  Publish fm User
  Publish fz User
  Publish pr Spy
  Publish se User
  Publish lz Spy
  Publish lm Spy
  Publish ls Spy
  SicsAlias lz ll Spy
  Publish le Spy
  Publish lt Spy
  Publish li  Spy
  Publish log User
  Publish sz  User
  Publish sw  User
  Publish pa  User
  Publish on  User
  Publish off User
}

#--------------------------------------------------------------------------
# a list of motors, needed at various stages in this

set tasmot { a1 a2 a3 a4 a5 a6 mcv sro ach mtl mtu stl stu atu mgl sgl \
	sgu agl}
#-------------------------------------------------------------------------
# some MAD variables can be directly mapped to internal SICS variables.
# Some others require special functions to be called for them to be set.
# These mappings are defined here through in a mapping array

for {set i 0} {$i < [llength $tasmot]} { incr i } {
  set mot [lindex $tasmot $i]
   set tasmap(l$mot) [format "%s softlowerlim " $mot]
   set tasmap(z$mot) [format "madZero %s "      $mot]
   set tasmap(u$mot) [format "%s softupperlim " $mot]
} 
set tasmap(ss) "scatSense ss "
set tasmap(sa) "scatSense sa "
set tasmap(sm) "scatSense sm "
set tasmap(fx) "fxi "

#----------------------------------------------------------------------
# mapping array output for debugging
#set l [array names tasmap]
#foreach e $l {
#  clientput [format " %s = %s" $e $tasmap($e)]
#}
#------------------------------------------------------------------------
# quite often we need to split a SICS answer of the form x = y and 
# extract the y. This is done here.

proc tasSplit {text} {
	set list [split $text =]
        return [lindex $list 1]
}

#----------------------------------------------------------------------
# put an angle into 360 
proc circlify {val} {
    set p $val
    while {$p > 360.0} {
	set p [expr $p - 360.]
    }
    return $p
}
#-------------------------------------------------------------------------
# motor zero points are handled differently in SICS and MAD:
# - MAD zero's are of opposite sign to SICS
# - Setting a MAD zero point also changes the limits.
# This function takes care of these issues.

proc madZero args {
    set length [llength $args]
    if { $length < 1} {
     error "ERROR: expected at least motor name as a parameter to madZero"
    } 
    set mot [lindex $args 0]
    if {$length == 1 } {
#inquiry case
      set zero [tasSplit [$mot softzero]]
      return [format "madZero = %f " [expr -$zero]] 
    } else {
# a new value has been given.
      set val [lindex $args 1]
      set val [expr -$val]
      set zero [tasSplit [$mot softzero]]
      set low [tasSplit [$mot softlowerlim]]
      set high [tasSplit [$mot softupperlim]]
      set displacement [expr $val - $zero]
      $mot softzero $val
      $mot softupperlim [expr $high - $displacement]
      $mot softlowerlim [expr $low  - $displacement]
    }
} 

#--------------------------------------------------------------------------
# This routine throws an error if a bad value for fx is given

proc fxi { {val -1000} } {
    if {$val == -1000} {
       return [format " fx = %d " [tasSplit [fx]] ]
    }  
    if { $val != 1 && $val != 2} {
       error "ERROR: Invalid value $val for parameter FX"
    } else {
	fx $val
    }
}

#-------------------------------------------------------------------------
# Changing the scattering sense has various consequences:
# for SM it is rejected as this requires a major rebuild of the guide hall.
# for SS only the parameter is changed.
# for SA - the parameter is changed
#        - the A5 zero point is rotated by 180 degree
#        - the lower software limit is set to the new zero point

proc scatSense {par {val  -1000} } {
    if { [tasSplit $par] == $val } {
       return
    }   
    switch $par {
      ss {
         set mot a3
      }
      sa {
	 set mot a5
      }
      sm {
         set mot a1
      }
      default {
       error "ERROR: unknown scattering sense $par"
      }
    }
#-------- inquiry case 
    if { $val == -1000 } {
       return [eval $par]
    }
    if {$val != 1 && $val != -1 && $val != 0 } {
       error "ERROR: invalid scattering sense $val"
    }
    switch $par {
       sm {
	  error \
	    "REJECTED: Pay 100 mil. swiss francs for a redesign of SINQ first"
       }
       ss {
          $par $val
	  clientput [format "     SS = %d" $val]
       }
       sa {
          set oldzero [tasSplit [madZero $mot]]
          set oldupper [tasSplit [$mot softupperlim]]
	  set oldlower [tasSplit [$mot softlowerlim]]
	  set oldsa    [tasSplit [sa]]
	   if { $val == 0 && $oldsa == 1} {
	       set newzero [expr $oldzero - 90.]
	       set newlower [expr $oldlower - 90.]
	       set newupper [expr $oldupper - 90.]
           } elseif {$val == 0 && $oldsa == -1} {
	       set newzero [expr $oldzero + 90.]
	       set newlower [expr $oldlower + 90.]
	       set newupper [expr $oldupper + 90.]
           } elseif { $val == 1 && $oldsa == 0} {
	       set newzero [expr $oldzero + 90.]
	       set newlower [expr $oldlower + 90.]
	       set newupper [expr $oldupper + 90.]
           } elseif { $val == -1 && $oldsa == 0} {
	       set newzero [expr $oldzero - 90.]
	       set newlower [expr $oldlower - 90.]
	       set newupper [expr $oldupper - 90.]
           } elseif { $val == 1 && $oldsa == -1} {
	       set newzero [expr $oldzero + 180. ]
	       set newlower [expr $oldlower + 180. ]
	       set newupper [expr $oldupper + 180. ]
           }  elseif {$val == -1 && $oldsa == 1} {
	       set newzero [expr $oldzero - 180. ]
	       set newlower [expr $oldlower - 180. ]
	       set newupper [expr $oldupper - 180. ]
           } else {
              error "Unknown SA setting combination"
           }
           $par $val
	   madZero $mot $newzero
	   $mot softupperlim $newupper
           $mot softlowerlim $newlower
       }	  
    }   
} 
#--------------------------------------------------------------------------
# The output command


proc out args {
    if {[llength $args] == 0 } {
      output ""
    } else {
      output [join $args]
    }
}
proc ou args {
    if {[llength $args] == 0 } {
      output ""
    } else {
      output [join $args]
    }
}

#--------------------------------------------------------------------------
# typeATokenizer extracts tokens from a command string. Tokens can be
# either variable names or - indicating a series of variables.
# Returns the token value or END if the end of the string text is
# reached. Uses and updates a variable pos which indicates the current 
# position in the string.

proc typeATokenizer {text pos} {
  upvar  pos p 
  set l [string length $text]
#------- check for end
    if {$p >= $l} {
       return END
    }
#-------- skip spaces
    for {} {$p < $l} {incr p} {
      set c [string index $text $p]
       if {$c == "-" } {
          incr p
          return "-"
        }
	if { $c != " " && $c != "," } {
	    break
        }
    }
    if {$p >= $l} {
       return END
    }
#---- extract token
    set start $p
#---- proceed to next terminator
    for {} {$p < $l} {incr p} {
      set c [string index $text $p]
	if { $c == " " || $c == "," || $c == "-" } {
	    break
        }
    }
    set stop [expr $p - 1]
    return [string range $text $start $stop]
}
 
#---------------------------------------------------------------------------
# The cl(ear) command for unfixing motors

proc cl args {
    global tasmot
    if {[llength $args] == 0} {
#------ clear all fixed motors
       foreach m $tasmot {
           set ret [catch {tasSplit [$m fixed]} x]
           if {$ret != 0 } {
              continue
           }
	   if { $x > 0 } {
	       clientput [format "%s unfixed" $m]
               $m fixed -1
           }
       }
       return
    } 
#------ trying to clear individual fixed motors
    set command [join $args]
    set command [string tolower $command]
    set pos 0
    set token [typeATokenizer $command $pos]
    while  {[string compare $token END] != 0 } {
        if {$token == "-" } {
          set l [llength $tasmot]
#------ handle a range, first find start
	    for {set start 0} {$start < $l} {incr start} {
              set e [lindex $tasmot $start]
		if { [string compare $e $last] == 0} {
                   incr start
                   break
                }
            }
            if { $start >= $l} {
		error [format "ERROR: %s is no motor" $last]
            }
#---------- next token is range stop
            set stop [typeATokenizer $command $pos]
#---------- now continue to loop until stop is found, thereby unfixing
            for {set i $start} { $i < $l} {incr i} {
		set e [lindex $tasmot $i]
		set ret [catch {$e fixed -1} msg]
		if {$ret != 0} {
		  error [format "ERROR: %s is no motor" $e]
		} else {
		  clientput [format "%s unfixed" $e]
		} 
                if {[string compare $e $stop] == 0 } {
		    break
                } 
            }
	} else {
#------ should be a single motor here
	   set last $token
	   set ret [catch {$token fixed -1} msg]
	   if {$ret != 0} {
	     error [format "ERROR: %s is no motor" $token]
	   } else {
	     clientput [format "%s unfixed" $token]
	   }  
       }
#------- do not forget to proceed
        set token [typeATokenizer $command $pos]
    }
}

#------------------------------------------------------------------------
# fi fix motor command

proc fi args {
    global tasmot
    if {[llength $args] <= 0} {
#------ list all fixed motors
       foreach m $tasmot {
           set ret [catch {tasSplit [$m fixed ] } x]
           if {$ret != 0 } {
              continue
           }
	   if { $x > 0 } {
	       clientput [format "%s fixed" $m]
           }
       }
       return
    } 
#------ parse motors to fix
    set command [join $args]
    set command [string tolower $command]
    set pos 0
    set token [typeATokenizer $command $pos]
    while  {[string compare $token END] != 0 } {
        if {$token == "-" } {
          set l [llength $tasmot]
#------ handle a range, first find start
	    for {set start 0} {$start < $l} {incr start} {
              set e [lindex $tasmot $start]
		if { [string compare $e $last] == 0} {
                   incr start
                   break
                }
            }
            if { $start >= $l} {
		error [format "ERROR: %s is no motor" $last]
            }
#---------- next token is range stop
            set stop [typeATokenizer $command $pos]
#---------- now continue to loop until stop is found, thereby fixing
            for {set i $start} { $i < $l} {incr i} {
		set e [lindex $tasmot $i]
		set ret [catch {$e fixed 1} msg]
		if {$ret != 0} {
		  error [format "ERROR: %s is no motor" $e]
		} else {
		  clientput [format "%s fixed" $e]
		} 
                if {[string compare $e $stop] == 0 } {
		    break
                } 
            }
        } else {
#------ should be a single motor here
	   set last $token
	   set ret [catch {$token fixed 1} msg]
	   if {$ret != 0} {
	     error [format "ERROR: %s is no motor" $token]
	   } else {
	     clientput [format "%s fixed" $token]
	   }  
        }
#------- do not forget to proceed
        set token [typeATokenizer $command $pos]
    }
}
#--------------------------------------------------------------------------
# varToken returns the next token in a variable setting string.
# handles pos as in type A syntax above.

proc varToken {text pos} {
  upvar  pos p 
  set l [string length $text]
#------- check for end
    if {$p >= $l} {
       return END
    }
#-------- skip spaces
    for {} {$p < $l} {incr p} {
      set c [string index $text $p]
	if { $c != " " && $c != "," && $c != "=" } {
	    break
        }
    }
    if {$p >= $l} {
       return END
    }
#---- extract token
    set start $p
#---- proceed to next terminator
    for {} {$p < $l} {incr p} {
      set c [string index $text $p]
	if { $c == " " || $c == "," || $c == "=" } {
	    break
        }
    }
    set stop [expr $p - 1]
    return [string range $text $start $stop]
}

#---------------------------------------------------------------------------
# varSet parses a string containing MAD variable statements and sets the
# variables. Thereby it has to take care of mappings and special variables
# which have to be set by special functions. The only format allowed here
# are name value pairs. 

proc varSet { command } {
    global tasmap
    set pos 0
    set token [varToken $command $pos]
    set value [varToken $command $pos]
    while { [string compare $token END] != 0} {
#----- first check for special things like user, local, title etc
       if { [string compare $token title] == 0 || \
           [string compare $token user] == 0 || \
           [string compare $token local] == 0 } {
           eval $command
           return
       } 
#----- now check for a numeric argument
       set t [SICSType $value]
       if { [string compare $t NUM] != 0 } {
	   error [format "ERROR: expected number for %s, got %s" \
                      $token $value]
       }
#------ now check for mapped variables
       if { [info exists tasmap($token)] == 1} {
	   set ret [catch {eval $tasmap($token) $value} msg]
           if { $ret != 0} {
             error [format "ERROR: > %s < while setting %s" $msg $token] 
           } else {
             clientput [format "  %s = %s" $token $value]
           }
       } else { 
	   set ret [catch {eval $token $value} msg]
           if { $ret != 0 } {
             error [format "ERROR: error %s while setting %s" $msg $token] 
           } else {
             clientput [format "  %s = %s" $token $value]
           }
       }       
       set token [varToken $command $pos]
       set value [varToken $command $pos]
    }
    catch {updateqe} msg
}
#--------------------------------------------------------------------------
# co for count is the funny MAD count procedure. Please note, that the 
# count mode is automatically set through the last MN or TI variable.

proc co args {
#------ set variables if present at command line
    if { [llength $args] > 0 } {
	set com [join $args]
        varSet $com
    }
#---- done this, now count
    set f [tasSplit [counter getpreset]]
    set ret [catch {eval counter count $f } msg] 
    if {$ret != 0} {
	error $msg
    }
#----- format output  
   set cts [tasSplit [counter getcounts]]
   set m1 [tasSplit [counter getmonitor 1]]
   set m2 [tasSplit [counter getmonitor 2]]
   set m3 [tasSplit [counter getmonitor 3]]
   return [format " Counts = %8d, M1 = %8d, M2 = %8d, M3 = %8d" \
	       $cts $m1 $m2 $m3]
}

#----------------------------------------------------------------------------
# fm or FindMaximum: does a scan, then proceeds to find the maximum
# of the peak and drives the first scan variable to the maximum.

proc fm args {
#------ do the scan first
    append com "sc " [ join $args] 
    set ret [catch {eval $com} msg]
    if { $ret != 0 } {
	error $msg
    } 
#    iscan simscan 15 .3 1000
#----- calculate the center
    set ret [catch {eval peak value} msg]
    if { $ret != 0 } {
	error $msg
    } 
    if { [string first "WARN" $msg ] >= 0 } {
	error [format "ERROR: failed to find peak: %s" $msg]
    }
    set val $msg
#------ find variable and drive to center
    set temp [iscan getvardata 0]
    set start [string first "." $temp]
    incr start
    set stop [string first "=" $temp]
    incr stop -1
    set var [string range $temp $start $stop]
    set ret [catch {eval dr $var $val} msg]
    if { $ret != 0 } {
	error $msg
    } 
}

#------------------------------------------------------------------------
# fz does almost the same as fm, but also sets the current position to be
# the zeropoint after driving

proc fz args {
#------ do the scan first
    append com "sc " [ join $args] 
    set ret [catch {eval $com} msg]
    if { $ret != 0 } {
	error $msg
    } 
    iscan simscan 15 .3 1000
#----- calculate the center
    set ret [catch {eval peak value} msg]
    if { $ret != 0 } {
	error $msg
    } 
    if { [string first "WARN" $msg ] >= 0 } {
	error [format "ERROR: failed to find peak: %s" $msg]
    }
    set val $msg
#------ find variable and drive to center
    set temp [iscan getvardata 0]
    set start [string first "." $temp]
    incr start
    set stop [string first "=" $temp]
    incr stop -1
    set var [string range $temp $start $stop]
    set ret [catch {eval dr $var $val} msg]
    if { $ret != 0 } {
	error $msg
    } 
#------- now do zero point
    set temp [eval $var hardposition]
    set newZero [tasSplit $temp]
    madZero [string trim $var] [expr -$newZero]
}

#--------------------------------------------------------------------------
# pr(int) values of variables

proc pr args {
    global tasmap
    set line [join $args]
    set line [string tolower $line]
    set pos 0
    set token [varToken $line $pos] 
    while { [string compare $token END] != 0 && \
            [string compare $token end] != 0 } {
#-------- check for mapped values first
	if { [info exists tasmap($token)] == 1 } {
	    set val [tasSplit [eval $tasmap($token)]]
            clientput [format " %s = %s" $token $val] 
        } else {
#------ simple variables go here
           set val [tasSplit [$token] ]
           clientput [format " %s = %s" $token $val] 
        }
        set token [varToken $line $pos]
    }
}

#-------------------------------------------------------------------------
# se(t) variables

proc se args {
#------- is it the only command line case?
    if {[llength $args] > 0 } {
      set line [join $args]
	return [varSet $line]
    } else {
#------- we are prompting
	while { 1== 1} {
#-------- check for error
	    set line [sicsprompt "SET> "]
	    if { [string first ERROR $line] >= 0} {
		error $line
	    }
#-------- check for end
	    if { [string length $line] < 4 } {
		return
            }
#------- OK, evaluate the line
	    set ret [catch {varSet $line} msg]
            if {$ret != 0} {
		clientput $msg
            }
        }
    }
}

#---------------------------------------------------------------------------
# lz list limits and zeros

proc lz args {
    global tasmap
    global tasmot
#--------- do header
    append outPut [format "         Limits & Zeros\n"]
    append outPut [format "         ===============\n"]
    append outPut [format "           Lo(hard)  Lo(soft)    Posn%s" \
                  " Hi(soft) Hi(hard)     Zero\n"]
#--------- do motors
    set count 0
    foreach mot $tasmot {
	set zero [tasSplit [madZero $mot]]
        set loh [tasSplit [eval $mot hardlowerlim]]
        set loh [expr $loh + $zero]
        set los [tasSplit [eval $mot softlowerlim]]
	set pos [tasSplit [eval $mot]]
	set his [tasSplit [eval $mot softupperlim]]
        set hih [tasSplit [eval $mot hardupperlim]]
        set hih [expr $hih + $zero]
        append outPut [format "%-10s %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \
		$mot $loh $los $pos $his $hih $zero]
        incr count
        if { $count == 6 } {
	    append outPut "         \n"
        } 
    }
    return $outPut
}

#--------------------------------------------------------------------------
# lm list machine parameters

proc lm args {
     append output "          Machine Parameters\n"
     append output "          ==================\n"
#----------- first line
     append output [format "       DM       DA        SM        SS%s\n" \
      "        SA     ALF1     ALF2     ALF3     ALF4"]
     set v1 [tasSplit [eval DM]]
     set v2 [tasSplit [eval DA]]
     set v3 [tasSplit [eval SM]]
     set v4 [tasSplit [eval SS]]
     set v5 [tasSplit [eval SA]]
     set v6 [tasSplit [eval ALF1]]
     set v7 [tasSplit [eval ALF2]]
     set v8 [tasSplit [eval ALF3]]
     set v9 [tasSplit [eval ALF4]]
     append output [format \
      " %8.4f %8.4f %9d %9d %9d %8.3f %8.3f %8.3f %8.3f\n"\
     $v1 $v2 $v3 $v4 $v5 $v6 $v7 $v8 $v9]
#--------- second line
     append output [format "     BET1     BET2     BET3     BET4%s\n" \
            "     ETAM     ETAA        FX        NP        TI"]
     set v1 [tasSplit [eval BET1]]
     set v2 [tasSplit [eval BET2]]
     set v3 [tasSplit [eval BET3]]
     set v4 [tasSplit [eval BET4]]
     set v5 [tasSplit [eval ETAM]]
     set v6 [tasSplit [eval ETAA]]
     set v7 [tasSplit [eval FX]]
     set v8 [tasSplit [eval NP]]
     set v9 [tasSplit [eval TI]]
     append output [format \
      " %8.3f %8.3f %8.3f %8.3f %8.3f %8.3f %9f %9f %8.0f\n"\
     $v1 $v2 $v3 $v4 $v5 $v6 $v7 $v8 $v9]
#---------- third line
     append output [format "       MN     IF1V     IF2H     HELM\n"]        
     set v1 [tasSplit [eval MN]]
     set v2 [tasSplit [eval IF1V]]
     set v3 [tasSplit [eval IF2H]]
     set v4 [tasSplit [eval HELM]]
     append output [format \
      " %8.0f %8.4f %8.4f %8.4f\n"\
     $v1 $v2 $v3 $v4]
     return $output
}

#---------------------------------------------------------------------------
# ls list sample parameters
proc ls args {
     append output "          Sample Parameters\n"
     append output "          =================\n"
#----------- first line
     append output [format "       AS       BS       CS       AA%s\n" \
      "       BB       CC     ETAS"]
     set v1 [tasSplit [eval AS]]
     set v2 [tasSplit [eval BS]]
     set v3 [tasSplit [eval CS]]
     set v4 [tasSplit [eval AA]]
     set v5 [tasSplit [eval BB]]
     set v6 [tasSplit [eval CC]]
     set v7 [tasSplit [eval ETAS]]
     append output [format \
      " %8.4f %8.4f %8.4f %8.3f %8.3f %8.3f %8.3f\n"\
     $v1 $v2 $v3 $v4 $v5 $v6 $v7]
#--------- second line
     append output [format "       AX       AY       AZ       BX%s\n" \
            "       BY       BZ"]
     set v1 [tasSplit [eval AX]]
     set v2 [tasSplit [eval AY]]
     set v3 [tasSplit [eval AZ]]
     set v4 [tasSplit [eval BX]]
     set v5 [tasSplit [eval BY]]
     set v6 [tasSplit [eval BZ]]
     append output [format \
      " %8.3f %8.3f %8.3f %8.3f %8.3f %8.3f\n"\
     $v1 $v2 $v3 $v4 $v5 $v6]

     return $output
}

#---------------------------------------------------------------------------
# le --> list energy

proc le args {
    set un [swunit]
    if { $un == 1} {
       append output "          Energy Units Thz\n"
    } else {
       append output "          Energy Units Mev\n"
    }
    append output "          ================\n"
    append output [format "                EI        KI        EF%s\n" \
      "        KF        QH        QK        QL"]
    set v1 [tasSplit [ei]]
    set v2 [tasSplit [ki]]
    set v3 [tasSplit [ef]]
    set v4 [tasSplit [kf]]
    set v5 [tasSplit [qh]]
    set v6 [tasSplit [qk]]
    set v7 [tasSplit [ql]]
    set val [format " %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f \n" \
             $v1 $v2 $v3 $v4 $v5 $v6 $v7]
    set v1 [tasSplit [tei]]
    set v2 [tasSplit [tki]]
    set v3 [tasSplit [tef]]
    set v4 [tasSplit [tkf]]
    set v5 [tasSplit [tqh]]
    set v6 [tasSplit [tqk]]
    set v7 [tasSplit [tql]]
    set val2 [format " %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f \n" \
             $v1 $v2 $v3 $v4 $v5 $v6 $v7]
    append output [format "POSN:     %s" $val]
    append output [format "TARG:     %s" $val2]
    append output [format "                EN        QM\n"]
    set v1 [tasSplit [en]]
    set v2 [tasSplit [qm]]
    set val [format " %9.4f %9.4f\n" $v1 $v2]
    set v1 [tasSplit [ten]]
    set v2 [tasSplit [tqm]]
    set val2 [format " %9.4f %9.4f\n" $v1 $v2]
    append output [format "POSN:     %s" $val]
    append output [format "TARG:     %s" $val2]

    return $output    
}

#-----------------------------------------------------------------------
# fmtMot formats a motors parameters in order to fit the format for
# the list targets commands

proc fmtMot mot {
    set zero [tasSplit [madZero $mot]]
    set pos [tasSplit [$mot]]
    set target [expr [tasSplit [eval $mot target]] + $zero]
    if { [tasSplit [eval $mot fixed]] < 0} {
      set fix  " "
    } else {
      set fix "f"
    }
    set txt [format "%-7s%1s %7.2f %7.2f %7.2f" $mot $fix $pos $target \
             $zero]
    return $txt
} 
#-------------------------------------------------------------------------
# lt --> list targets

proc lt args {
   append output "          Positions and Targets \n"
   append output "          ===================== \n"
   append output [format "            Posn    Targ    Zero %s" \
                  "                Posn    Targ    Zero\n"]
   append output [format "%s  |  %s\n" \
                 [fmtMot A1] " "]
   append output [format "%s  |  %s\n" \
                 [fmtMot A2] [fmtMot ATL]]
   append output [format "%s  |  %s\n" \
                 [fmtMot A3] [fmtMot ATU] ]
   append output [format "%s  |  %s\n" \
                 [fmtMot A4] " " ]
   append output [format "%s  |  %s\n" \
                 [fmtMot A5] [fmtMot MGL] ]
   append output [format "%s  |  %s\n" \
                 [fmtMot A6] [fmtMot SGL] ]
   append output [format "%s  |  %s\n" \
                 [fmtMot MCV] [fmtMot SGU] ]
   append output [format "%s  |  %s\n" \
                 [fmtMot SRO] " " ]
   append output [format "%s  |  %s\n" \
                 [fmtMot ACH] [fmtMot AGL] ]
   append output [format "%s  |  %s\n" \
                 [fmtMot MTL] " " ]
   append output [format "%s  |  %s\n" \
                 [fmtMot MTU] " " ]
   return $output  
}

#--------------------------------------------------------------------------
# li --> list everything

proc li args {
   clientput [lm]
   clientput [ls]
   clientput [lz]
   clientput [lt]
   clientput [le]
}

#-----------------------------------------------------------------------
# make a new log file name for log
proc makeLog args {
    set tim [sicstime]
    set l [split $tim]
    set l2 [split [lindex $l 1] ":"]
    set nam [format "madsics-%s@%s-%s-%s.log" [lindex $l 0] \
             [lindex $l2 0] [lindex $l2 1] [lindex $l2 2]]
    return $nam
}
#-------------------------------------------------------------------------
# log the logging control command

set madlog disabled

proc log args {
    global madlog
#------ no args, just print status
    if { [ llength $args] == 0 } {
	if { [string compare $madlog disabled] == 0 } {
	    return "Logging is disabled"
        } else { 
	    return [format "Logging to %s" $madlog]
        }  
    }
#------args, action according to keyword
    set key [string tolower [lindex $args 0]]
    switch $key {
      new {
          set madlog [makeLog]
	  commandlog new $madlog
      }
      start {
          set madlog [makeLog]
	  commandlog new $madlog
      }
      close {
	  commandlog close
          set madlog disabled
      }
      default {
	  append output "Log understands: \n"
          append output "\tLog new      : new logfile\n"
	  append output "\tLog start    : start logging\n"
          append output "\tLog close    : stop logging\n"
          return $output
      }
    } 
}

#--------------------------------------------------------------------------
# sz -->setzero

proc sz args {
    global tasmot
    set usage "\n Usage: \n\t sz motor newval \n"
    set line [string tolower [join $args]]
    set pos 0 
    set mot [varToken $line $pos]
    set val [varToken $line $pos]
    if { [lsearch $tasmot $mot] < 0 } {
	error [format "ERROR: %s is no motor\n %s" $mot $usage]
    }
    if { [string compare [SICStype $val] NUM ] != 0 } {
	error [format "ERROR: expected number, got %s \n%s" $val $usage]
    }
#-------- output, output, output.........
    append output [format "Values     :  Lo(hard) Lo(soft)    Posn%s" \
                    "   Target  Hi(soft) Hi(hard)    Zero\n"] 
    set zero [tasSplit [madZero $mot]]
    set loh [tasSplit [eval $mot hardlowerlim]]
    set loh [expr $loh + $zero]
    set los [tasSplit [eval $mot softlowerlim]]
    set pos [tasSplit [eval $mot]]
    set his [tasSplit [eval $mot softupperlim]]
    set hih [tasSplit [eval $mot hardupperlim]]
    set hih [expr $hih + $zero]
    set targ [expr [tasSplit [eval $mot target]] + $zero]
    append output [format \
          "%-8sOld: %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \
		$mot $loh $los $pos $targ $his $hih $zero]
#-------action
    madZero $mot $val
    catch {updateqe} msg
#-------- more output
    set zero [tasSplit [madZero $mot]]
    set loh [tasSplit [eval $mot hardlowerlim]]
    set loh [expr $loh + $zero]
    set los [tasSplit [eval $mot softlowerlim]]
    set pos [tasSplit [eval $mot]]
    set his [tasSplit [eval $mot softupperlim]]
    set hih [tasSplit [eval $mot hardupperlim]]
    set hih [expr $hih + $zero]
    set targ [expr [tasSplit [eval $mot target]] + $zero]
    append output [format \
          "        New: %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \
		$loh $los $pos $targ $his $hih $zero]
    return $output
}
#---------------------------------------------------------------------------
# switches and the sw command

#--------------------------------------------------------------------------
# powdersw deals with the powder switch

set powder 0

proc powdersw args {
    global powder
    if { [llength $args] > 0 } {
	switch [lindex $args 0] {
	    on {
		as 6.28
                cs 6.28
                bs 6.28
                aa 90.
                bb 90.
                cc 90.
                a3 fixed 1
		set powder 1
                return "Q now in reverse Angstroem"
            }
            off {
		set powder 0
                a3 fixed -1
            }
            flip {
		if {$powder == 1 } {
		    return [powdersw off]
                } else {
		    return [powdersw on] 
                }
            }
            default {
		error "ERROR: syntax error, only on, off, flip allowed"
            }
        }
    }  else {
	if { $powder == 1} {
	    return [format "  %-30s : %-5s" "Powder Mode" "on"] 
        } else {
	    return [format "  %-30s : %-5s" "Powder Mode" "off"] 
        }
    }
}
#----------------------------------------------------------------------
# switch polarisation
proc polsw args {
    if { [llength $args] > 0 } {
	switch [lindex $args 0] {
	    on {
		lpa 1
                return "Polarisation mode enabled"
            }
            off {
		lpa 0
		return "Polarisation mode disabled"
            }
            flip {
		if {[tasSplit [lpa]] == 1 } {
		    return [polsw off]
                } else {
		    return [polsw on] 
                }
            }
            default {
		error "ERROR: syntax error, only on, off, flip allowed"
            }
        }
    }  else {
	if { [tasSplit [lpa]] == 1} {
	    return [format "  %-30s : %-5s" "Polarisation Mode" "on"] 
        } else {
	    return [format "  %-30s : %-5s" "Polarisation Mode" "off"] 
        }
    }
}

#-----------------------------------------------------------------------
# mapping switches to procedures handling them

set switches(powder) powdersw
set switches(pol)    polsw

#------------------------------------------------------------------------
# prsw prints switches
proc prsw args {
    global switches
    set l [array names switches]
    foreach e $l {
          append output [eval $switches($e)] "\n"
    }
    return $output
}

#--------------------------------------------------------------------------
# sw --> the switches command



proc sw args {
    global switches
    set swlist [array names switches]
    set maxsw [llength $swlist]
#------- no args
    if { [llength $args] <= 0 } {
        clientput [prsw]
        set line [sicsprompt "Switch number? : "]
        while { [string length $line] > 1 } {
            set ret [catch {expr $line - 1} num]
            if { $ret != 0 } {
		error [format "ERROR: expected number, got %s" \
                           $line]
            }
            if {$num >= $maxsw} {
		error "ERROR: switch number out of bounds"
            }
            if { $num < 0} {
	      return [prsw]
            }
            clientput [eval $switches([lindex $swlist $num]) flip]            
            clientput [prsw]
            set line [sicsprompt "Switch number? "]
        }  
    } else {
#-------- direct on command line
	set line [join $args]
        set pos 0
        set sw [varToken $line $pos]
        set op [varToken $line $pos]
        while { [string compare $sw END] != 0 } {
          set ret [catch {expr $sw - 1} num]
          if { $ret != 0 } {
		error [format "ERROR: expected number, got %s" \
                           $sw]
          }
          if { $num >= $maxsw || $num < 0 } {
		error "ERROR: switch number out of bounds"
          }
          clientput [eval $switches([lindex $swlist $num]) $op]
          set sw [varToken $line $pos]
          set op [varToken $line $pos]
        }
        clientput [prsw]
    }
}
#---------------------------------------------------------------------------
# pa : set polarization analysis file
#--------------------------------------------------------------------------
proc pa args {
    if {[llength $args] < 1} {
	error "Usage: pa polarisation analysis file"
    }
    set fil [lindex $args 0]
    if {[string first "." $fil] < 0} {
	set fil $fil.pal
    }
    polfile $fil
} 
#--------------------------------------------------------------------------
# on and off for switching spin flippers
#-------------------------------------------------------------------------
proc checkarg args {
    if {[llength $args] < 1} {
	error "No flipper to set given"
    }
    set flipper [string trim [string tolower [lindex $args 0]]]
    if { [string compare $flipper f1] == 0 || \
	    [string compare $flipper f2] == 0} {
	return $flipper
    } else {
        error [format "%s not a recognized flipper" $flipper]
    }      
}
#------------------------------------------------------------------------
proc on args {
    set flip [checkarg $args]
    if { [string compare $flip f1] == 0 } {
	f1 1
	set i1val [expr [tasSplit [tki]] * [tasSplit [if1h]]]
	set i2val [tasSplit [if1v]]
	return [dr i1 $i1val i2 $i2val]
    } else {
	f2 1
	set i3val [expr [tasSplit [tkf]] * [tasSplit [if2h]]]
	set i4val [tasSplit [if2v]]
	return [dr i3 $i3val i4 $i4val]
    }
}
#-------------------------------------------------------------------------
proc off args {
    set flip [checkarg $args]
    if { [string compare $flip f1] == 0 } {
	f1 0
	return [dr i1 .0 i2 .0]
    } else {
	f2 0
	return [dr i3 .0 i4 .0]
    }
}
