1178 lines
35 KiB
Tcl
1178 lines
35 KiB
Tcl
#---------------------------------------------------------------------------
|
|
# 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 ll Spy
|
|
Publish lm Spy
|
|
Publish ls 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 atl}
|
|
#-------------------------------------------------------------------------
|
|
# 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 "
|
|
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)]
|
|
#}
|
|
#------------------------------------------------------------------------
|
|
# 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.]
|
|
}
|
|
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. ]
|
|
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"
|
|
}
|
|
$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, ll is the same
|
|
|
|
proc ll args {
|
|
return 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 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
|
|
set ret [catch {run i1 0} msg]
|
|
set ret [catch {run i2 0} msg]
|
|
set ret [catch {run i3 0} msg]
|
|
set ret [catch {run i4 0} msg]
|
|
set ret [catch {run i5 0} msg]
|
|
set ret [catch {run i6 0} msg]
|
|
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]
|
|
}
|
|
}
|