\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
deleted file mode 100644
index 7119ffb9..00000000
--- a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl
+++ /dev/null
@@ -1,1517 +0,0 @@
-#-----------------------------------------------------------------------------
-# 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