- TDC histogram memory driver sort of working
- New class for scripting datafiles - SANS-II almost complete initialization file
This commit is contained in:
cvs
261
sans2com.tcl
Normal file
261
sans2com.tcl
Normal file
@@ -0,0 +1,261 @@
|
||||
#-----------------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
#======================== 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 coliimator $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 [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 InitVal 0
|
||||
wait 1
|
||||
set ret [catch {Success} msg]
|
||||
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
|
||||
# writeFloatVar vrot velo
|
||||
# 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
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user