1518 lines
47 KiB
Tcl
1518 lines
47 KiB
Tcl
#-----------------------------------------------------------------------------
|
|
# This file contains all the scripted commands to make a SICS-TAS look
|
|
# almost like a MAD-TAS.
|
|
#
|
|
# This version is special to RITA-2!!
|
|
#
|
|
# Mark Koennecke, September 2005
|
|
#
|
|
# The specialities for RITA have been separated and this is controlled
|
|
# by testing the instrument name. This way I can use the same version for
|
|
# TASP, RITA-2 and EIGER
|
|
#
|
|
# Mark Koennecke, November 2010
|
|
#------------------------------------------------------------------------
|
|
# 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]
|
|
}
|
|
#------------------------------------------------------------------------
|
|
|
|
set inst [string trim [tasSplit [instrument]]]
|
|
if {[string first RITA $inst] >= 0} {
|
|
set ritaspecial 1
|
|
} else {
|
|
set ritaspecial 0
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
# The syntax emulation needs a list of motors in several cases. This
|
|
# list is in tasmot. On startup the interpreter is queried for motors,
|
|
# which then are used to initialize the list. This has to be before the
|
|
# initialization in order to be visible when initializing below.
|
|
#-----------------------------------------------------------------------
|
|
set tasmot [list a1 a2 a3 a4 a5 a6]
|
|
#----------------------------------------------------------------------
|
|
proc initMotList {} {
|
|
global tasmot
|
|
set t [dir mot]
|
|
set list [split $t]
|
|
foreach mot $list {
|
|
set mot [string trim $mot]
|
|
set mot [string tolower $mot]
|
|
if { [string length $mot] < 2} {
|
|
continue
|
|
}
|
|
if { [lsearch -exact $tasmot $mot] < 0} {
|
|
lappend tasmot $mot
|
|
}
|
|
}
|
|
}
|
|
#--------------- debug....
|
|
proc printmotlist {} {
|
|
global tasmot
|
|
foreach mot $tasmot {
|
|
set var [tasSplit [$mot]]
|
|
clientput "$mot = $var"
|
|
}
|
|
return OK
|
|
}
|
|
|
|
proc enable {} {
|
|
global tasmot
|
|
foreach mot $tasmot {
|
|
catch {
|
|
set var [tasSplit [$mot enable]]
|
|
if {$var > 0} {
|
|
clientput "$mot enabled"
|
|
} else {
|
|
clientput " $mot disabled"
|
|
}
|
|
}
|
|
}
|
|
return OK
|
|
}
|
|
|
|
proc target {} {
|
|
global tasmot
|
|
clientput "Motor HardPosition TargetPosition Position"
|
|
foreach mot $tasmot {
|
|
catch {
|
|
set var1 [tasSplit [$mot targetposition]]
|
|
set var2 [tasSplit [$mot hardposition]]
|
|
set var3 [tasSplit [$mot]]
|
|
clientput "$mot $var2 $var1 $var3"
|
|
}
|
|
}
|
|
return OK
|
|
}
|
|
|
|
#------------------------------------------------------------------------
|
|
proc initTasScan {} {
|
|
iscan configure script
|
|
iscan function writeheader tasscan header
|
|
iscan function prepare tasscan prepare
|
|
iscan function drive tasscan drive
|
|
iscan function count tasscan count
|
|
iscan function collect tasscan collect
|
|
iscan function writepoint tasscan writepoint
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
if { [info exists tasubinit] == 0 } {
|
|
set tasubinit 1
|
|
Publish do User
|
|
Publish ou User
|
|
Publish out User
|
|
Publish fi User
|
|
Publish fix User
|
|
Publish cl User
|
|
Publish clear User
|
|
Publish co User
|
|
Publish fm User
|
|
Publish fz User
|
|
Publish pr Spy
|
|
Publish se User
|
|
Publish lz Spy
|
|
Publish ll Spy
|
|
Publish lm Spy
|
|
Publish ls Spy
|
|
Publish syncbackup Spy
|
|
Publish le Spy
|
|
Publish lt Spy
|
|
Publish li Spy
|
|
Publish log User
|
|
Publish sz User
|
|
Publish pa User
|
|
Publish on User
|
|
Publish off User
|
|
Publish sp User
|
|
Publish dr User
|
|
Publish sc User
|
|
Publish sf User
|
|
Publish cell User
|
|
Publish ref User
|
|
Publish makeub User
|
|
Publish makeauxub User
|
|
Publish addauxref User
|
|
Publish makeubfromcell User
|
|
Publish listub User
|
|
Publish xmlprepare User
|
|
Publish xmlwritepoint User
|
|
Publish donothing User
|
|
Publish xmlfinish User
|
|
Publish syncdrive User
|
|
initMotList
|
|
# initTasScan
|
|
# initxmlscan
|
|
Publish printmotlist User
|
|
Publish enable User
|
|
Publish target User
|
|
}
|
|
#------------------------------------------------------------------------
|
|
# TASMAD relies on the order of variables in memory in order to interpret
|
|
# scan or drive commands. In the new syntax motor order is only preserved
|
|
# for the QE motors, not for real motors. This list configures the order.
|
|
#------------------------------------------------------------------------
|
|
set tasOrderList [list qh qk ql en]
|
|
#-------------------------------------------------------------------------
|
|
# 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 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 "
|
|
set tasmap(dm) "tasub mono dd "
|
|
set tasmap(da) "tasub ana dd "
|
|
for {set i 0} { $i < 8} { incr i} {
|
|
set cur [format "i%1.1d" $i]
|
|
set tasmap(l$cur) [format "%s lowerlimit " $cur]
|
|
set tasmap(u$cur) [format "%s upperlimit " $cur]
|
|
}
|
|
|
|
#----------------------------------------------------------------------
|
|
# mapping array output for debugging
|
|
#set l [array names tasmap]
|
|
#foreach e $l {
|
|
# clientput [format " %s = %s" $e $tasmap($e)]
|
|
#}
|
|
#----------------------------------------------------------------------
|
|
# put an angle into 360
|
|
proc circlify {val} {
|
|
set p $val
|
|
while {$p > 360.0} {
|
|
set p [expr $p - 360.]
|
|
}
|
|
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 [circlify $val]
|
|
$mot softupperlim [circlify [expr $high - $displacement]]
|
|
$mot softlowerlim [circlify [expr $low - $displacement]]
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
# This routine throws an error if a bad value for fx is given
|
|
#--------------------------------------------------------------------------
|
|
proc fxi { {val UNKNOWN} } {
|
|
if {[string compare $val UNKNOWN] ==0} {
|
|
return [format " fx = %2s " [tasSplit [tasub const]] ]
|
|
}
|
|
return [tasub const $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} } {
|
|
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 } {
|
|
switch $par {
|
|
sm {
|
|
return [format "sm = %d" [tasSplit [tasub mono ss]]]
|
|
}
|
|
ss {
|
|
return [format "ss = %d" [tasSplit [tasub ss]]]
|
|
}
|
|
sa {
|
|
return [format "sa = %d" [tasSplit [tasub ana ss]]]
|
|
}
|
|
default {
|
|
error "Unknown scattering sense requested"
|
|
}
|
|
}
|
|
}
|
|
if {$val != 1 && $val != -1 && $val != 0 } {
|
|
error "ERROR: invalid scattering sense $val"
|
|
}
|
|
switch $par {
|
|
sm {
|
|
error \
|
|
"REJECTED: Pay 100 mil. CHF for a redesign of SINQ first"
|
|
}
|
|
ss {
|
|
tasub ss $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 [tasub ana ss]]
|
|
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. ]
|
|
set newlower [circlify $newlower]
|
|
set newupper [circlify $newupper]
|
|
} 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"
|
|
}
|
|
tasub ana ss $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 clear args {
|
|
eval cl $args
|
|
}
|
|
#------------------------------------------------------------------------
|
|
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 fix args {
|
|
eval fi $args
|
|
}
|
|
#----------------------------------------------------------------------
|
|
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] } {
|
|
#----- first check for special things like user, local, title etc
|
|
if { [string compare $token title] == 0 || \
|
|
[string compare $token user] == 0 || \
|
|
[string compare $token output] == 0 || \
|
|
[string compare $token local] == 0 } {
|
|
eval $command
|
|
return
|
|
}
|
|
if { [string compare $token out] == 0 || \
|
|
[string compare $token ou] == 0 } {
|
|
append txt $token " " [string range $command $pos end]
|
|
eval output $txt
|
|
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 {tasub update} 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 coritacount {mode preset nloop} {
|
|
set rmode [ritamode]
|
|
hm countmode $mode
|
|
hm preset $preset
|
|
for { set i 0} {$i < $nloop} {incr i} {
|
|
set ret [catch {eval hm countblock} msg]
|
|
if {$ret != 0} {
|
|
error $msg
|
|
}
|
|
#----- format output
|
|
set cts [tasSplit [hm sum 0 127 0 127]]
|
|
set m1 [tasSplit [counter getmonitor 1]]
|
|
set m2 [tasSplit [counter getmonitor 2]]
|
|
set m3 [tasSplit [counter getmonitor 3]]
|
|
set time [tasSplit [counter gettime] ]
|
|
clientput [format \
|
|
" Counts = %8d, M1 = %8d, M2 = %8d, M3 = %8d, Time = %8.2f" \
|
|
$cts $m1 $m2 $m3 $time]
|
|
if {[string first none $rmode] >= 0} {
|
|
for {set i 1} {$i < 13} {incr i} {
|
|
set win [format "w%ds" $i]
|
|
append txt [format " %s = %d" $win [sumPSDWindow $i]]
|
|
}
|
|
clientput $txt
|
|
}
|
|
}
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc conormalcount {mode preset nloop} {
|
|
counter setmode $mode
|
|
for { set i 0} {$i < $nloop} {incr i} {
|
|
set ret [catch {eval counter count $preset } 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]]
|
|
set m3 25
|
|
set time [tasSplit [counter gettime] ]
|
|
clientput [format \
|
|
" Counts = %8d, M1 = %8d, M2 = %8d, M3 = %8d, Time = %8.2f" \
|
|
$cts $m1 $m2 $m3 $time]
|
|
}
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
proc co args {
|
|
global ritaspecial
|
|
set mode [tasSplit [counter getmode]]
|
|
set preset [tasSplit [counter getpreset]]
|
|
set nloop 1
|
|
#------ set variables if present at command line
|
|
if { [llength $args] > 0 } {
|
|
set com [join $args]
|
|
set pos 0
|
|
set token [varToken $com $pos]
|
|
while { [string compare $token -end] != 0} {
|
|
set token [string tolower $token]
|
|
if { [string compare $token np] == 0} {
|
|
set nloop [varToken $com $pos]
|
|
if { [string is integer $nloop] != 1} {
|
|
error "ERROR: expected integer value after NP"
|
|
}
|
|
} elseif {[string compare $token mn] == 0} {
|
|
set mode monitor
|
|
set preset [varToken $com $pos]
|
|
if { [string is double $preset] != 1} {
|
|
error "ERROR: expected numeric value after MN"
|
|
}
|
|
} elseif {[string compare $token ti] == 0} {
|
|
set mode timer
|
|
set preset [varToken $com $pos]
|
|
if { [string is double $preset] != 1} {
|
|
error "ERROR: expected numeric value after TI"
|
|
}
|
|
}
|
|
set token [varToken $com $pos]
|
|
}
|
|
}
|
|
#---- done this, now count
|
|
if {$ritaspecial} {
|
|
return [coritacount $mode $preset $nloop]
|
|
} else {
|
|
return [conormalcount $mode $preset $nloop]
|
|
}
|
|
}
|
|
#----------------------------------------------------------------------------
|
|
# 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] } {
|
|
#-------- 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, ll is the same
|
|
#---------------------------------------------------------------------------
|
|
proc ll args {
|
|
return [eval lz $args]
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
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 tasub mono dd]]
|
|
set v2 [tasSplit [eval tasub ana dd]]
|
|
set v3 [tasSplit [eval tasub mono ss]]
|
|
set v4 [tasSplit [eval tasub ss]]
|
|
set v5 [tasSplit [eval tasub ana ss]]
|
|
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 [tasub const]]
|
|
append output [format \
|
|
" %8.3f %8.3f %8.3f %8.3f %8.3f %8.3f %2s\n"\
|
|
$v1 $v2 $v3 $v4 $v5 $v6 $v7]
|
|
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 lat [tasSplit [tasub cell]]
|
|
set l [split [string trim $lat]]
|
|
set v1 [lindex $l 0]
|
|
set v2 [lindex $l 1]
|
|
set v3 [lindex $l 2]
|
|
set v4 [lindex $l 3]
|
|
set v5 [lindex $l 4]
|
|
set v6 [lindex $l 5]
|
|
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 [tasub listub]
|
|
append output "Current Content of Reflection List\n"
|
|
append output [tasub listref]
|
|
return $output
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# le --> list energy
|
|
#---------------------------------------------------------------------------
|
|
proc le args {
|
|
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 [ei target]]
|
|
set v2 [tasSplit [ki target]]
|
|
set v3 [tasSplit [ef target]]
|
|
set v4 [tasSplit [kf target]]
|
|
set v5 [tasSplit [qh target]]
|
|
set v6 [tasSplit [qk target]]
|
|
set v7 [tasSplit [ql target]]
|
|
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 [en target]]
|
|
set v2 [tasSplit [qm target]]
|
|
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 {tasub update} 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
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# 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]
|
|
}
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc do {filename} {
|
|
return [exe [string trim $filename]]
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc syncbackup {file} {
|
|
backup motorSave
|
|
backup $file
|
|
backup motorSave
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
proc syncdrive {mot pos} {
|
|
set test [catch {tasSplit [$mot fixed]} fix]
|
|
if {$test == 0} {
|
|
$mot fixed -1
|
|
}
|
|
drive $mot $pos
|
|
if {$test == 0} {
|
|
eval $mot fixed $fix
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
# "set posttion" sp to reset the zero-position.
|
|
# syntax: "SP <axes> <value>" to set the softzero value of <axes>
|
|
# in a way that the targetposition is set to <value>.
|
|
# J. Stahn, 10. 2001
|
|
#-------------------------------------------------------------------------
|
|
proc sp { axes wert } {
|
|
set tt [$axes hardposition]
|
|
set t [split $tt "="]
|
|
set posh [lindex $t 1]
|
|
# extended to included motors with negative signs (M. Laver 7/6/10)
|
|
set tt [$axes sign]
|
|
set t [split $tt "="]
|
|
set poss [lindex $t 1]
|
|
$axes softzero [expr $poss*$posh - $wert]
|
|
}
|
|
#-------------- ---------------------------------------------------------
|
|
# locate scan variable. This is not so easy at TASP as sometimes the first
|
|
# ones really do not vary. We choose the first one which does vary.
|
|
# This returns the name, the start and the step.
|
|
#-------------------------------------------------------------------------
|
|
proc findscanvar {} {
|
|
set result "NONE,.0,.0"
|
|
set nvar [tasSplit [iscan noscanvar]]
|
|
for { set i 0} { $i < $nvar} { incr i } {
|
|
set ret [catch {iscan getvardata $i} msg]
|
|
if {$ret != 0} {
|
|
break
|
|
}
|
|
set l [split $msg =]
|
|
set xlist [lindex $l 1]
|
|
set start [lindex $xlist 0]
|
|
set 2pos [lindex $xlist 1]
|
|
if { abs($2pos - $start) > .0} {
|
|
set step [expr $2pos - $start]
|
|
set l2 [split [lindex $l 0] .]
|
|
set scanvar [lindex $l2 1]
|
|
set result "$scanvar,[string trim $start],$step"
|
|
break
|
|
}
|
|
}
|
|
return $result
|
|
}
|
|
#-------------- simulate scan info ----------------------------------------
|
|
proc scan {name} {
|
|
switch $name {
|
|
uuinterest {
|
|
return [iscan uuinterest]
|
|
}
|
|
pinterest {
|
|
return [iscan interest]
|
|
}
|
|
getcounts {
|
|
return [iscan getcounts]
|
|
}
|
|
info {
|
|
set scanvar [findscanvar]
|
|
append result [tasSplit [iscan np]] ",1," $scanvar
|
|
append result ,
|
|
append result [string trim [tasSplit [iscan getfile]]]
|
|
return $result
|
|
}
|
|
default {
|
|
error "ERROR: $name not supported"
|
|
}
|
|
}
|
|
}
|
|
#------------------------------------------------------------------------
|
|
# The TAS dr(ive) command. Takes care of variable order.
|
|
#------------------------------------------------------------------------
|
|
proc dr args {
|
|
global tasOrderList ritaspecial
|
|
set command [join $args]
|
|
set pos 0
|
|
set lastVar neutronenPhaser
|
|
set token [varToken $command $pos]
|
|
while { [string compare $token -end] != 0} {
|
|
if { [string is double $token] == 1} {
|
|
lappend targets $token
|
|
if { [info exists motors] == 0} {
|
|
error "ERROR: Need motor first before handling target"
|
|
}
|
|
if { [llength $targets] > [llength $motors] } {
|
|
set idx [lsearch $tasOrderList $lastVar]
|
|
if { $idx >= 0} {
|
|
incr idx
|
|
set lastVar [lindex $tasOrderList $idx]
|
|
lappend motors $lastVar
|
|
}
|
|
}
|
|
if { [llength $motors] != [llength $targets]} {
|
|
error "ERROR: do not know what to drive to $token"
|
|
}
|
|
} else {
|
|
set lastVar $token
|
|
lappend motors $lastVar
|
|
}
|
|
set token [varToken $command $pos]
|
|
}
|
|
if { [info exists motors] == 0} {
|
|
error "ERROR: Nothing to drive!"
|
|
}
|
|
if { [llength $motors] > [llength $targets] } {
|
|
error "ERROR: Not enough targets for motors"
|
|
}
|
|
append drivecommand "drive "
|
|
for {set i 0} {$i < [llength $motors]} {incr i} {
|
|
append drivecommand [lindex $motors $i]
|
|
append drivecommand " "
|
|
append drivecommand [lindex $targets $i]
|
|
append drivecommand " "
|
|
}
|
|
tasub silent 0
|
|
set status [catch {eval $drivecommand} msg]
|
|
foreach mot $motors {
|
|
clientput [format "New %s position: %.5g" $mot [tasSplit [$mot]]]
|
|
}
|
|
tasub update
|
|
if { [lsearch $args ef] >= 0 && $ritaspecial} {
|
|
adjustritaanalyzer bla blu 1
|
|
}
|
|
if { $status != 0} {
|
|
error $msg
|
|
} else {
|
|
return $msg
|
|
}
|
|
}
|
|
#----------------------------------------------------------------------
|
|
# The TAS sc(an) command. Translates the TAS sc syntax into the SICS
|
|
# syntax
|
|
#-----------------------------------------------------------------------
|
|
proc sc args {
|
|
global tasOrderList
|
|
global __tasdata
|
|
set command [join $args]
|
|
lastscancommand sc $command
|
|
tasscan pol -1
|
|
set np 0
|
|
set mode [tasSplit [counter getmode]]
|
|
set preset [tasSplit [counter getpreset]]
|
|
set lastVar quarkPhaser
|
|
set pos 0
|
|
set state 0
|
|
# states:
|
|
# 0 = expectToken, 1 = expectPosition, 2 = continuePosition
|
|
# 3 = expectIncrement, 4 = continueIncrement
|
|
|
|
set token [varToken $command $pos]
|
|
while { [string compare $token -end] != 0} {
|
|
if { [string is double $token] == 1 } {
|
|
#--------- numbers
|
|
switch $state {
|
|
0 { error "ERROR: expected name at $pos in $command" }
|
|
1 {
|
|
set scanpos($lastVar) $token
|
|
set state 2
|
|
}
|
|
2 {
|
|
set idx [lsearch $tasOrderList $lastVar]
|
|
if { $idx < 0} {
|
|
error "ERROR: variable order handling only for qh,qk,ql,en"
|
|
}
|
|
incr idx
|
|
set lastVar [lindex $tasOrderList $idx]
|
|
lappend scanvars $lastVar
|
|
set scanpos($lastVar) $token
|
|
}
|
|
3 {
|
|
set inc($lastVar) $token
|
|
set state 4
|
|
}
|
|
4 {
|
|
set idx [lsearch $tasOrderList $lastVar]
|
|
if { $idx < 0} {
|
|
error "ERROR: variable order handling only for qh,qk,ql,en"
|
|
}
|
|
incr idx
|
|
set lastVar [lindex $tasOrderList $idx]
|
|
set inc($lastVar) $token
|
|
}
|
|
default {
|
|
error "ERROR: programming error: bad code in num handling in sc"
|
|
}
|
|
}
|
|
} else {
|
|
#--------- text tokens
|
|
set token [string tolower $token]
|
|
set c [string index $token 0]
|
|
set type [sicstype $token]
|
|
if { [string compare $token np] == 0} {
|
|
set np [varToken $command $pos]
|
|
if { [string is integer $np] != 1} {
|
|
error "ERROR: expected integer after NP"
|
|
}
|
|
set state 0
|
|
} elseif { [string compare $token mn] == 0} {
|
|
set preset [varToken $command $pos]
|
|
if { [string is double $preset] != 1} {
|
|
error "ERROR: expected numeric token after MN"
|
|
}
|
|
set mode monitor
|
|
set state 0
|
|
} elseif { [string compare $token ti] == 0} {
|
|
set preset [varToken $command $pos]
|
|
if { [string is double $preset] != 1} {
|
|
error "ERROR: expected numeric token after TI"
|
|
}
|
|
set mode timer
|
|
set state 0
|
|
} elseif { [string compare $c d] == 0 \
|
|
&& [string compare DRIV $type] != 0} {
|
|
set state 3
|
|
set lastVar [string range $token 1 end]
|
|
} else {
|
|
lappend scanvars $token
|
|
set state 1
|
|
set lastVar $token
|
|
}
|
|
}
|
|
set token [varToken $command $pos]
|
|
}
|
|
#=========== we are done parsing! Check if there is enough to go on
|
|
if { [info exists scanvars] == 0} {
|
|
error "ERROR: nothing to scan"
|
|
}
|
|
set __tasdata(qe) 0
|
|
set qeVars [list qh qk ql ei ef en qm ki kf]
|
|
foreach var $scanvars {
|
|
if {[lsearch -exact $qeVars [string tolower $var]] >= 0} {
|
|
set __tasdata(qe) 1
|
|
}
|
|
if { [info exists scanpos($var)] == 0} {
|
|
error "ERROR: position for $var missing"
|
|
}
|
|
if { [info exists inc($var)] == 0} {
|
|
error "ERROR: increment for $var missing"
|
|
}
|
|
}
|
|
set tasmode [string trim [tasSplit [tasub const]]]
|
|
if {[string compare $tasmode kf] == 0 && $__tasdata(qe) == 1} {
|
|
set __tasdata(qe) 2
|
|
}
|
|
#========= prepare scan and run
|
|
iscan clear
|
|
foreach var $scanvars {
|
|
set start [expr $scanpos($var) - $inc($var) * ($np - 1)/2.]
|
|
iscan add $var $start $inc($var)
|
|
}
|
|
return [iscan run $np $mode $preset]
|
|
}
|
|
#---------------------------------------------------------------------
|
|
proc cell args {
|
|
return [tasSplit [eval tasub cell $args]]
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc ref args {
|
|
if { [llength $args] == 0} {
|
|
return [tasub listref]
|
|
}
|
|
set key [string trim [lindex $args 0]]
|
|
if { [string compare $key clear] == 0} {
|
|
if { [llength $args] > 1 } {
|
|
if {[string first all [lindex $args 1]] >= 0} {
|
|
return [tasub clear]
|
|
} else {
|
|
return [tasub del [lindex $args 1]]
|
|
}
|
|
} else {
|
|
error "Need argument to ref clear"
|
|
}
|
|
} elseif {[string compare $key aux] == 0} {
|
|
set qpos [lrange $args 1 end]
|
|
append cmd "tasub addauxref " [join $qpos]
|
|
return [eval $cmd]
|
|
} else {
|
|
return [eval tasub addref $args]
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc makeub args {
|
|
if { [llength $args] >= 2} {
|
|
tasub makeub [lindex $args 0] [lindex $args 1]
|
|
return OK
|
|
} else {
|
|
return [tasub listub]
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc makeauxub {qh qk ql} {
|
|
tasub makeauxub $qh $qk $ql
|
|
}
|
|
#-------------------------------------------------------------------
|
|
proc addauxref {qh qk ql} {
|
|
tasub addauxref $qh $qk $ql
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc makeubfromcell args {
|
|
return [tasub makeubfromcell]
|
|
}
|
|
#---------------------------------------------------------------------
|
|
proc listub args {
|
|
append output [tasSplit [tasub cell]]
|
|
append output "\n"
|
|
append output [tasub listub]
|
|
append output [tasub listref]
|
|
return $output
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc sf args {
|
|
tasscan fast 1
|
|
set ret [catch {eval sc $args} msg]
|
|
tasscan fast 0
|
|
if { $ret != 0} {
|
|
error $msg
|
|
} else {
|
|
return $msg
|
|
}
|
|
}
|