PSI sics-cvs-psi_pre-ansto
This commit is contained in:
Douglas Clowes
334
sans2com.tcl
Normal file
334
sans2com.tcl
Normal file
@@ -0,0 +1,334 @@
|
||||
#-----------------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
Reference in New Issue
Block a user