\n"
+ append result "| User | " [tasSplit [user]] " |
|---|
\n"
+ append result "| Title | "
+ append result [tasSplit [title]] " |
|---|
\n"
+ append result "| Status | "
+ append result [tasSplit [status]] " |
|---|
\n"
+ append result "| Last Scan Command | "
+ append result [tasSplit [lastcommand]] " |
|---|
\n"
+ append result "| A1 | "
+ append result [tasSplit [a1]] " | A2 | "
+ append result [tasSplit [a2]] " |
|---|
\n"
+ append result "| A3 | "
+ append result [tasSplit [a3]] " | A4 | "
+ append result [tasSplit [a4]] " |
|---|
\n"
+ append result "| A5 | "
+ append result [tasSplit [a5]] " | A6 | "
+ append result [tasSplit [a6]] " |
|---|
\n"
+ append result "| Ki | " [tasSplit [ki]] " | "
+ append result "Kf | " [tasSplit [kf]] " | "
+ append result "En | " [tasSplit [en]] " |
|---|
\n"
+ append result "| Qh | " [tasSplit [qh]] " | "
+ append result "Qk | " [tasSplit [qk]] " | "
+ append result "Ql | " [tasSplit [ql]] " |
|---|
\n"
+ append result "
\n"
+}
diff --git a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl
new file mode 100644
index 00000000..7119ffb9
--- /dev/null
+++ b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl
@@ -0,0 +1,1517 @@
+#-----------------------------------------------------------------------------
+# 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