#--------------------------------------------------------------------------- # 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] } }