98cfb3ddda
- Implemented automatic backup on parameter change - Implemented silent restore - Cleaned a couple of unused flags from connection object
335 lines
9.7 KiB
Tcl
335 lines
9.7 KiB
Tcl
#-----------------------------------------------------------------------
|
|
# Scripts for the SANS-II Risoe instrument as installed at PSI.
|
|
#
|
|
# Initial version: Mark Koennecke, Febrary 2003
|
|
#----------------------------------------------------------------------
|
|
#source $root/log.tcl
|
|
#source $root/batch.tcl
|
|
source $root/nxsupport.tcl
|
|
|
|
if { [info exists sansinit] == 0 } {
|
|
set sansinit 1
|
|
Publish beamstop Spy
|
|
Publish stopmot User
|
|
# Publish collRead Spy #-----for debugging
|
|
# Publish collSet Spy #-----for debugging
|
|
Publish collimator Spy
|
|
Publish coll Spy
|
|
# Publis att Spy
|
|
Publish batchrun User
|
|
Publish LogBook User
|
|
Publish count User
|
|
Publish Repeat User
|
|
Publish storedata User
|
|
Publish disto Spy
|
|
Publish statusinfo Spy
|
|
Publish displaycontrol User
|
|
Publish displayunits User
|
|
Publish setdispar User
|
|
}
|
|
#======================== general useful stuff ======================
|
|
proc SplitReply { text } {
|
|
set l [split $text =]
|
|
return [lindex $l 1]
|
|
}
|
|
#======================== Collimator stuff ===========================
|
|
proc collRead args {
|
|
set res [ecb1 func 164 0 0 0 0]
|
|
set l [split $res]
|
|
return [expr ([lindex $l 1] << 8) + [lindex $l 0]]
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc collSet {val} {
|
|
switch $val {
|
|
1 { set d 0}
|
|
2 { set d 01}
|
|
3 { set d 03}
|
|
4 { set d 07}
|
|
5 { set d 017}
|
|
6 { set d 037}
|
|
default {
|
|
error "Invalid collimation length requested"
|
|
}
|
|
}
|
|
ecb1 func 148 $d 0 0 0
|
|
return OK
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc collimator args {
|
|
if { [llength $args ] < 1} {
|
|
#------------- read case
|
|
set res [collRead]
|
|
set res [expr $res & 255]
|
|
set length -1
|
|
switch $res {
|
|
0 { set length 1}
|
|
1 { set length 2}
|
|
3 { set length 3}
|
|
7 { set length 4}
|
|
15 { set length 5}
|
|
31 { set length 6}
|
|
default {
|
|
error "Unknown reply $res from colRead"
|
|
}
|
|
}
|
|
return [format "collimator = %f" $length]
|
|
} else {
|
|
#------------- set case
|
|
set rights [SplitReply [config myrights]]
|
|
if {$rights > 2} {
|
|
error "Insufficient rights to drive collimator"
|
|
}
|
|
return [collSet [lindex $args 0]]
|
|
}
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc coll args {
|
|
return collimator $args
|
|
}
|
|
#======================== Beamstop stuff ==============================
|
|
proc beamstop args {
|
|
#----- without arguments: request
|
|
if { [llength $args] < 1} {
|
|
set res [collRead 0]
|
|
if { ($res & 256) > 0 } {
|
|
return "0 in"
|
|
} else {
|
|
return "1 out"
|
|
}
|
|
}
|
|
#---- with arguments: change, but only with at least user privilege
|
|
set rights [SplitReply [config myrights]]
|
|
if {$rights > 2} {
|
|
error "Insufficient rights to drive beamstop"
|
|
}
|
|
switch [lindex $args 0] {
|
|
0 { set d 1}
|
|
in {set d 1}
|
|
1 {set d 0}
|
|
out {set d 0}
|
|
default{
|
|
error "Invalid beamstop requested"
|
|
}
|
|
}
|
|
ecb1 func 160 $d 0 0 0
|
|
return OK
|
|
}
|
|
#================================ stopmot ================================
|
|
proc stopmot args {
|
|
ecb1 func 132 0 0 0 0
|
|
}
|
|
#=============================== counting ===============================
|
|
proc count { {mode NULL } { preset NULL } } {
|
|
#----- deal with mode
|
|
set mode2 [string toupper $mode]
|
|
set mode3 [string trim $mode2]
|
|
set mc [string index $mode2 0]
|
|
if { [string compare $mc T] == 0 } {
|
|
banana CountMode Timer
|
|
} elseif { [string compare $mc M] == 0 } {
|
|
banana CountMode Monitor
|
|
}
|
|
#------ deal with preset
|
|
if { [string compare $preset NULL] != 0 } {
|
|
banana preset $preset
|
|
}
|
|
#------ prepare a count message
|
|
set ret [catch {Success} msg]
|
|
set a [banana preset]
|
|
set aa [SplitReply $a]
|
|
set b [banana CountMode]
|
|
set bb [SplitReply $b]
|
|
set tt [sicstime]
|
|
set sn [SplitReply [sample]]
|
|
starttime [sicstime]
|
|
ClientPut [format " Starting counting in %s mode with a preset of %s" \
|
|
$bb $aa ]
|
|
ClientPut [format "Count started at %s" $tt]
|
|
ClientPut [format " sample name: %s" $sn]
|
|
#------- count
|
|
banana count
|
|
set ret [catch {Success} msg]
|
|
#------- StoreData
|
|
storedata
|
|
set ttt [sicstime]
|
|
if { $ret != 0 } {
|
|
ClientPut [format "Counting ended at %s" $ttt]
|
|
error [format "Counting ended with error: %s" $msg]
|
|
}
|
|
ClientPut [format "Counting ended at %s" $ttt]
|
|
ClientPut "Total Counts: [SplitReply [banana sum 0 128 0 128]]"
|
|
}
|
|
#---------------- Repeat -----------------------------------------------
|
|
proc repeat { num {mode NULL} {preset NULL} } {
|
|
for { set i 0 } { $i < $num } { incr i } {
|
|
count $mode $preset
|
|
}
|
|
}
|
|
#=================== Data File Writing =================================
|
|
proc writeBeforeSample args {
|
|
writeTextVar etitle title
|
|
writeTextVar etime starttime
|
|
nxscript puttext endtime [sicstime]
|
|
writeTextVar iname instrument
|
|
nxscript puttext sname SINQ, Paul Scherrer Institut
|
|
nxscript puttext stype Continuous flux spallation source
|
|
nxscript puttext vname Dornier velocity selector
|
|
set res [nvs list]
|
|
set l [split $res "\n"]
|
|
nxscript putfloat vrot [SplitReply [lindex $l 0]]
|
|
writeFloatVar vtilt tilt
|
|
writeFloatvar vlambda lambda
|
|
writeFloatVar colli collimator
|
|
# writeFloatVar atti attenuator
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc writeSample args {
|
|
writeTextVar san sample
|
|
writeTextVar stable sampletable
|
|
#------------- sample chamber
|
|
nxscript putmot charo sr
|
|
nxscript putmot chax stx
|
|
nxscript putmot chaz stz
|
|
nxscript putmot chac sc
|
|
#------------- goniometer
|
|
nxscript putmot goniox tu
|
|
nxscript putmot gonioy tl
|
|
nxscript putmot goniochi gu
|
|
nxscript putmot goniophi gl
|
|
#------------- xyz-table
|
|
nxscript putmot tablex sx
|
|
nxscript putmot tabley sy
|
|
nxscript putmot tablez sz
|
|
nxscript putmot tableom om
|
|
#------------ sans1table
|
|
nxscript putmot sans1chi chi
|
|
nxscript putmot sans1om ome
|
|
#---------- environment
|
|
if { [catch {set tmp [SplitReply [temperature]]} tmp] == 0} {
|
|
nxscript putfloat satemp $tmp
|
|
}
|
|
if { [catch {set tmp [SplitReply [magnet]]} tmp] == 0} {
|
|
nxscript putfloat samag $tmp
|
|
}
|
|
writeTextVar saenv environment
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc writeAfterSample args {
|
|
#-------- beamstop
|
|
nxscript putmot vsx dh
|
|
nxscript putmot vsy dv
|
|
set tst [beamstop]
|
|
if { [string first in $tst] >= 0} {
|
|
nxscript putfloat bspos 0
|
|
} else {
|
|
nxscript putfloat bspos 1.
|
|
}
|
|
#------- counter
|
|
nxscript putcounter cter counter
|
|
#------- detector
|
|
nxscript putmot ddx dz
|
|
nxscript puthm ddcounts banana
|
|
for { set i 0} { $i < 128} {incr i} {
|
|
set detar($i) [expr -64. + $i]
|
|
}
|
|
nxscript putarray ddcx detar 128
|
|
nxscript putarray ddcy detar 128
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc makeLinks args {
|
|
nxscript makelink dan ddcounts
|
|
nxscript makelink dan ddcx
|
|
nxscript makelink dan ddcy
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc storedata args {
|
|
global root
|
|
set filnam [makeFileName]
|
|
clientput [format "Writing %s" $filnam]
|
|
nxscript create5 $filnam $root/sans2.dic
|
|
writeStandardAttributes $filnam
|
|
|
|
writeBeforeSample
|
|
|
|
writeSample
|
|
|
|
writeAfterSample
|
|
|
|
makeLinks
|
|
|
|
nxscript close
|
|
}
|
|
#========================= laser distance reading ========================
|
|
proc disto args {
|
|
global distoCON
|
|
gpib sendwithterm $distoCON a 13
|
|
gpib readtillterm $distoCON 10
|
|
gpib sendwithterm $distoCON g 13
|
|
set result [gpib readtillterm $distoCON 10]
|
|
set l [split $result " +" ]
|
|
return [string trim [lindex $l 1] 0]
|
|
}
|
|
#========================= helper function for status display ============
|
|
proc statusinfo {} {
|
|
append result "SICS = " [SplitReply [status]] " \n"
|
|
append result [title] " \n"
|
|
append result [sample] " \n"
|
|
append result [user] " \n"
|
|
set tst [nvs list]
|
|
set l [split $tst "\n"]
|
|
append result "Velocity selector rotation = " \
|
|
[SplitReply [lindex $l 0]] " \n"
|
|
append result "lambda = " [SplitReply [lambda]] " \n"
|
|
append result "Collimation length = " [SplitReply [collimator]] " \n"
|
|
append result "filenumber = " [SplitReply [sicsdatanumber]] " \n"
|
|
return $result
|
|
}
|
|
#============= scripts for controlling the ECB display unit ============
|
|
proc disloadpar {unit offset val} {
|
|
ecb1 func 166 0 [expr $unit -1] $offset $val
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc startdisplay {} {
|
|
ecb1 func 128 0 0 0 1
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc stopdisplay {} {
|
|
ecb1 func 129 0 0 0 0
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc setdispar {unit name key parnum} {
|
|
switch $key {
|
|
timer {set type 1}
|
|
scaler {set type 2}
|
|
ratemeter {set type 4}
|
|
motor {set type 3}
|
|
encoder {set type 5}
|
|
default {
|
|
error "Unknown parameter key"
|
|
}
|
|
}
|
|
stopdisplay
|
|
disloadpar $unit 0 [ecb1 toint [string index $name 0]]
|
|
disloadpar $unit 1 [ecb1 toint [string index $name 1]]
|
|
disloadpar $unit 2 [ecb1 toint [string index $name 2]]
|
|
disloadpar $unit 3 $parnum
|
|
disloadpar $unit 4 $type
|
|
startdisplay
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
proc cleardisplay {} {
|
|
ecb1 func 131 0 0 0 0
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
proc defdisplay { num} {
|
|
ecb1 func 166 1 $num 0 0
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc displayunits { u1 u2 u3 u4} {
|
|
ecb1 func 130 $u1 $u2 $u3 $u4
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc displaycontrol {command} {
|
|
ecb1 func 170 0 0 $command 0
|
|
}
|