update for Lyrebird
r3101 | jgn | 2011-04-11 15:09:26 +1000 (Mon, 11 Apr 2011) | 1 line
This commit is contained in:
Jing Chen
committed by
Douglas Clowes
Douglas Clowes
parent
8eb9a86c01
commit
5153e16e86
@@ -1,418 +0,0 @@
|
||||
##
|
||||
# @file Spin flipper control for Quokka
|
||||
#
|
||||
# Author: Ferdi Franceschini (ffr@ansto.gov.au) May 2010
|
||||
#
|
||||
# The spin flipper can be installed with the following command,
|
||||
# ::scobj::rfgen::mkFlipper {
|
||||
# name "flipper"
|
||||
# address 1
|
||||
# opCurr 68
|
||||
# opFreq 241
|
||||
# IP localhost
|
||||
# PORT 65123
|
||||
# tuning 1
|
||||
# currtol 1
|
||||
# interval 2
|
||||
# }
|
||||
#
|
||||
# NOTE:
|
||||
# If tuning=1 this will generate flipper/set_current and flipper/set_frequency
|
||||
# nodes for the instrument scientists.
|
||||
# The tuning parameter should be set to 0 for the users.
|
||||
#
|
||||
# The operation_manual_Platypus_polarization_system.doc:Sec 3.1 states the following
|
||||
# Attention
|
||||
# a) Do not switch on the RF output with non-zero current setting (the current
|
||||
# control becomes unstable)! If unsure, rotate the current setting
|
||||
# potentiometer 10 turns counter-clockwise.
|
||||
# b) In case of RF vacuum discharge (harmful for the system)
|
||||
# " the main symptom is that the RF power source turns into CV mode, the
|
||||
# voltage increases to 34 Vem and the current decreases;
|
||||
# " switch off the RF output;
|
||||
# " decrease current setting by rotating the potentiometer 10 turns counter-clockwise;
|
||||
# " verify the vacuum level in the tank and restart the flipper operation only if it is below 0.01 mbar.
|
||||
|
||||
namespace eval ::scobj::rfgen {
|
||||
# Control states
|
||||
variable RAMPIDLE 0
|
||||
variable RAMPSTOP 1
|
||||
variable RAMPSTART 2
|
||||
variable RAMPBUSY 3
|
||||
variable RAMPTOZERO 4
|
||||
variable FLIPOFF 5
|
||||
variable MAXVOLTAGE 34
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Utility for trimming zero padding from current and frequency readings.
|
||||
# We do this to avoid misinterpreting numbers as octal
|
||||
proc ::scobj::rfgen::mkStatArr {stateArrName stateReport} {
|
||||
upvar $stateArrName stateArr
|
||||
array set stateArr $stateReport
|
||||
|
||||
if {$stateArr(curr) != 0} {
|
||||
set val [string trimleft $stateArr(curr) 0]
|
||||
if {[string is integer $val]} {
|
||||
set stateArr(curr) $val
|
||||
} else {
|
||||
set stateArr(curr) -1
|
||||
}
|
||||
}
|
||||
if {$stateArr(freq) != 0} {
|
||||
set val [string trimleft $stateArr(freq) 0]
|
||||
if {[string is integer $val]} {
|
||||
set stateArr(freq) $val
|
||||
} else {
|
||||
set stateArr(freq) -1
|
||||
}
|
||||
}
|
||||
if {$stateArr(voltage) != 0} {
|
||||
set val [string trimleft $stateArr(voltage) 0]
|
||||
if {[string is integer $val]} {
|
||||
set stateArr(voltage) $val
|
||||
} else {
|
||||
set stateArr(voltage) -1
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Switch the spin flipper on or off
|
||||
proc ::scobj::rfgen::set_flip_on {basePath} {
|
||||
variable RAMPSTART
|
||||
variable RAMPTOZERO
|
||||
|
||||
set flipState [sct target]
|
||||
switch $flipState {
|
||||
"0" {
|
||||
hsetprop $basePath targetCurr 0
|
||||
hsetprop $basePath OutputState 0
|
||||
hsetprop $basePath ramping $RAMPSTART
|
||||
sct update 0
|
||||
sct utime readtime
|
||||
}
|
||||
"1" {
|
||||
hsetprop $basePath targetCurr [hgetpropval $basePath opCurr]
|
||||
hsetprop $basePath targetFreq [hgetpropval $basePath opFreq]
|
||||
hsetprop $basePath OutputState 1
|
||||
hsetprop $basePath ramping $RAMPSTART
|
||||
sct update 1
|
||||
sct utime readtime
|
||||
}
|
||||
default {
|
||||
set ErrMsg "[sct] invalid input $flipState, Valid states for [sct] are 1 or 0"
|
||||
sct seterror "ERROR: $ErrMsg"
|
||||
return -code error $ErrMsg
|
||||
}
|
||||
}
|
||||
return idle
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Get the target current and scale it for the RF generator.
|
||||
# Also updates the operating current for this session.
|
||||
#
|
||||
# @param basePath, The "spin-flipper" object path, this is where we keep our state variables.
|
||||
proc ::scobj::rfgen::set_current {basePath} {
|
||||
variable RAMPSTART
|
||||
|
||||
set newCurr [sct target]
|
||||
|
||||
set current [expr {round(10.0 * $newCurr)}]
|
||||
hsetprop $basePath targetCurr $current
|
||||
hsetprop $basePath opCurr $current
|
||||
hsetprop $basePath ramping $RAMPSTART
|
||||
hsetprop $basePath OutputState 1
|
||||
return idle
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Get the target frequency. Also updates the operating frequency for this session.
|
||||
#
|
||||
# @param basePath, The "spin-flipper" object path, this is where we keep our state variables.
|
||||
proc ::scobj::rfgen::set_frequency {basePath} {
|
||||
variable RAMPSTART
|
||||
|
||||
set newFreq [sct target]
|
||||
|
||||
hsetprop $basePath targetFreq $newFreq
|
||||
hsetprop $basePath opFreq $newFreq
|
||||
hsetprop $basePath ramping $RAMPSTART
|
||||
hsetprop $basePath OutputState 1
|
||||
return idle
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Request a state report from the RF generator
|
||||
proc ::scobj::rfgen::rqStatFunc {} {
|
||||
sct send "L:[sct address]"
|
||||
return rdState
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Read and record the state report from the RF generator
|
||||
proc ::scobj::rfgen::rdStatFunc {} {
|
||||
variable RAMPBUSY
|
||||
variable RAMPSTART
|
||||
variable RAMPTOZERO
|
||||
variable RAMPIDLE
|
||||
variable FLIPOFF
|
||||
variable MAXVOLTAGE
|
||||
|
||||
set basePath [sct]
|
||||
|
||||
set currSuperState [sct ramping]
|
||||
set updateFlipper 0
|
||||
set statStr [sct result]
|
||||
if {[string match "ASCERR:*" $statStr]} {
|
||||
sct geterror $statStr
|
||||
sct ramping $RAMPIDLE
|
||||
return stateChange
|
||||
}
|
||||
set statList [split $statStr "|="]
|
||||
foreach {k v} $statList {
|
||||
if {$k == "type"} {
|
||||
lappend temp "$k $v"
|
||||
continue
|
||||
}
|
||||
if {[string is integer $v]} {
|
||||
lappend temp "$k $v"
|
||||
} else {
|
||||
lappend temp "$k -1"
|
||||
}
|
||||
}
|
||||
set statList [join $temp]
|
||||
mkStatArr stateArr $statList
|
||||
|
||||
if {$statList != [sct oldStateRep]} {
|
||||
hset $basePath/flip_current [expr {$stateArr(curr) / 10.0}]
|
||||
hset $basePath/flip_frequency $stateArr(freq)
|
||||
hset $basePath/flip_voltage $stateArr(voltage)
|
||||
hset $basePath/flip_on $stateArr(O)
|
||||
hset $basePath/state_report $statList
|
||||
sct update $statList
|
||||
sct utime readtime
|
||||
sct oldStateRep $statList
|
||||
}
|
||||
if {$currSuperState != $FLIPOFF && $stateArr(curr) > [sct currTol] && $stateArr(O) && $stateArr(CV)} {
|
||||
broadcast "WARNING: spin flipper has switched to voltage control, voltage = $stateArr(voltage)"
|
||||
if {$stateArr(voltage) >= $MAXVOLTAGE} {
|
||||
sct ramping $FLIPOFF
|
||||
}
|
||||
}
|
||||
|
||||
return stateChange
|
||||
}
|
||||
|
||||
##
|
||||
# @brief State transition function
|
||||
proc ::scobj::rfgen::stateFunc {} {
|
||||
variable RAMPIDLE
|
||||
variable RAMPSTOP
|
||||
variable RAMPSTART
|
||||
variable RAMPBUSY
|
||||
variable RAMPTOZERO
|
||||
variable FLIPOFF
|
||||
variable MAXVOLTAGE
|
||||
|
||||
set basePath [sct]
|
||||
|
||||
set currSuperState [sct ramping]
|
||||
mkStatArr stateArr [hval $basePath/state_report]
|
||||
set currControlStatus [sct status]
|
||||
|
||||
|
||||
switch $currSuperState [ subst -nocommands {
|
||||
$RAMPSTART {
|
||||
# broadcast RAMPSTART
|
||||
if [string match $currControlStatus "IDLE"] {
|
||||
statemon start flipper
|
||||
sct status "BUSY"
|
||||
sct ramping $RAMPBUSY
|
||||
return ramp
|
||||
} else {
|
||||
# Flipper is off, set current to zero before switching on
|
||||
sct origTargetCurr [sct targetCurr]
|
||||
sct targetCurr 0
|
||||
sct OutputState 0
|
||||
sct ramping $RAMPTOZERO
|
||||
return ramp
|
||||
}
|
||||
}
|
||||
$RAMPTOZERO {
|
||||
# broadcast RAMPTOZERO
|
||||
if {$stateArr(curr) <= [sct currTol]} {
|
||||
# We've reached a safe state so switch on and ramp to target current
|
||||
sct targetCurr [sct origTargetCurr]
|
||||
sct OutputState 1
|
||||
sct ramping $RAMPBUSY
|
||||
} else {
|
||||
sct targetCurr 0
|
||||
sct OutputState 0
|
||||
}
|
||||
return ramp
|
||||
}
|
||||
$RAMPBUSY {
|
||||
# broadcast RAMPBUSY
|
||||
if { [expr {abs($stateArr(curr) - [sct targetCurr])}] <= [sct currTol] } {
|
||||
sct ramping $RAMPSTOP
|
||||
return idle
|
||||
}
|
||||
return ramp
|
||||
}
|
||||
$FLIPOFF {
|
||||
sct targetCurr 0
|
||||
sct OutputState 0
|
||||
if { $stateArr(curr) <= [sct currTol] } {
|
||||
sct ramping $RAMPSTOP
|
||||
broadcast "ERROR: Spin flipper switched off voltage exceeds $MAXVOLTAGE in voltage control state, check vacuum"
|
||||
return idle
|
||||
} else {
|
||||
return ramp
|
||||
}
|
||||
}
|
||||
$RAMPSTOP {
|
||||
# broadcast RAMPSTOP
|
||||
if [string match $currControlStatus "BUSY"] {
|
||||
statemon stop flipper
|
||||
sct status "IDLE"
|
||||
}
|
||||
sct ramping $RAMPIDLE
|
||||
return idle
|
||||
}
|
||||
$RAMPIDLE {
|
||||
# broadcast RAMPIDLE
|
||||
return idle
|
||||
}
|
||||
}]
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Ramps the current up or down in steps of 0.5A and/or sets the frequency
|
||||
proc ::scobj::rfgen::rampFunc {} {
|
||||
set basePath [sct]
|
||||
set currSuperState [sct ramping]
|
||||
mkStatArr stateArr [hval $basePath/state_report]
|
||||
|
||||
set targetCurr [sct targetCurr]
|
||||
set targetFreq [sct targetFreq]
|
||||
set output [sct OutputState]
|
||||
|
||||
if { [expr {abs($stateArr(curr) - [sct targetCurr])}] <= [sct currTol] } {
|
||||
set curr $stateArr(curr)
|
||||
} elseif {$targetCurr < $stateArr(curr)} {
|
||||
set curr [expr $stateArr(curr)-5]
|
||||
if {$curr < $targetCurr} {
|
||||
set curr $targetCurr
|
||||
}
|
||||
} elseif {$targetCurr > $stateArr(curr)} {
|
||||
set curr [expr $stateArr(curr)+5]
|
||||
if {$curr > $targetCurr} {
|
||||
set curr $targetCurr
|
||||
}
|
||||
}
|
||||
set reply [sct_rfgen send "S:[sct address]:I=$curr:F=$targetFreq:K3=$stateArr(K3):K2=$stateArr(K2):K1=$stateArr(K1):O=$output"]
|
||||
|
||||
return idle
|
||||
}
|
||||
|
||||
|
||||
##
|
||||
# @brief Make a spin flipper control object
|
||||
#
|
||||
# @param argList, {name "flipper" address "1" opCurr 68 opFreq 241 IP localhost PORT 65123 tuning 0 interval 1}
|
||||
#
|
||||
# name: name of spin flipper object
|
||||
# address: address assigned to RF generator 1-9
|
||||
# opCurr: the operating current, when you switch the spin flipper on it will ramp to this current
|
||||
# opFreq: the operating frequency, when you switch on the spin flipper it will set this frequency
|
||||
# IP: IP address of RF generator moxa box
|
||||
# PORT: Port number assigned to the generator on the moxa-box
|
||||
# tuning: boolean, set tuning=1 to allow instrument scientists to set the current and frequency
|
||||
# interval: polling and ramping interval in seconds. One sets the ramp rate to 0.5A/s
|
||||
proc ::scobj::rfgen::mkFlipper {argList} {
|
||||
variable RAMPIDLE
|
||||
|
||||
# Generate parameter array from the argument list
|
||||
foreach {k v} $argList {
|
||||
set KEY [string toupper $k]
|
||||
set pa($KEY) $v
|
||||
}
|
||||
|
||||
MakeSICSObj $pa(NAME) SCT_OBJECT
|
||||
sicslist setatt $pa(NAME) klass instrument
|
||||
sicslist setatt $pa(NAME) long_name $pa(NAME)
|
||||
|
||||
# hfactory /sics/$pa(NAME)/status plain spy text
|
||||
hsetprop /sics/$pa(NAME) status "IDLE"
|
||||
hfactory /sics/$pa(NAME)/state_report plain internal text
|
||||
hfactory /sics/$pa(NAME)/flip_current plain internal float
|
||||
hfactory /sics/$pa(NAME)/flip_frequency plain internal int
|
||||
hfactory /sics/$pa(NAME)/flip_voltage plain internal int
|
||||
hfactory /sics/$pa(NAME)/flip_on plain internal int
|
||||
|
||||
hsetprop /sics/$pa(NAME) read ::scobj::rfgen::rqStatFunc
|
||||
hsetprop /sics/$pa(NAME) rdState ::scobj::rfgen::rdStatFunc
|
||||
hsetprop /sics/$pa(NAME) stateChange ::scobj::rfgen::stateFunc
|
||||
hsetprop /sics/$pa(NAME) ramp ::scobj::rfgen::rampFunc
|
||||
|
||||
hsetprop /sics/$pa(NAME) address $pa(ADDRESS)
|
||||
hsetprop /sics/$pa(NAME) tuning $pa(TUNING)
|
||||
hsetprop /sics/$pa(NAME) ramping $RAMPIDLE
|
||||
hsetprop /sics/$pa(NAME) opCurr $pa(OPCURR)
|
||||
hsetprop /sics/$pa(NAME) opFreq $pa(OPFREQ)
|
||||
hsetprop /sics/$pa(NAME) targetCurr 0
|
||||
hsetprop /sics/$pa(NAME) origTargetCurr 0
|
||||
hsetprop /sics/$pa(NAME) oldStateRep ""
|
||||
|
||||
hsetprop /sics/$pa(NAME) currTol $pa(CURRTOL)
|
||||
|
||||
hfactory /sics/$pa(NAME)/comp_current plain internal float
|
||||
hsetprop /sics/$pa(NAME)/comp_current units "A"
|
||||
hset /sics/$pa(NAME)/comp_current $pa(COMPCURR)
|
||||
hfactory /sics/$pa(NAME)/guide_current plain internal float
|
||||
hsetprop /sics/$pa(NAME)/guide_current units "A"
|
||||
hset /sics/$pa(NAME)/guide_current $pa(GUIDECURR)
|
||||
hfactory /sics/$pa(NAME)/thickness plain internal float
|
||||
hsetprop /sics/$pa(NAME)/thickness units "mm"
|
||||
hset /sics/$pa(NAME)/thickness $pa(THICKNESS)
|
||||
|
||||
hfactory /sics/$pa(NAME)/set_flip_on plain user int
|
||||
hsetprop /sics/$pa(NAME)/set_flip_on write ::scobj::rfgen::set_flip_on /sics/$pa(NAME)
|
||||
# Only create the set current and frequency nodes when commissioning
|
||||
|
||||
# Initialise properties required for generating the API for GumTree and to save data
|
||||
::scobj::hinitprops $pa(NAME) flip_current flip_frequency flip_voltage flip_on comp_current guide_current thickness
|
||||
hsetprop /sics/$pa(NAME)/comp_current mutable false
|
||||
hsetprop /sics/$pa(NAME)/guide_current mutable false
|
||||
hsetprop /sics/$pa(NAME)/thickness mutable false
|
||||
|
||||
if {[SplitReply [rfgen_simulation]] == "false"} {
|
||||
makesctcontroller sct_rfgen rfamp $pa(IP):$pa(PORT)
|
||||
mkStatArr stateArr [split [sct_rfgen transact "L:$pa(ADDRESS)"] "|="]
|
||||
|
||||
hset /sics/$pa(NAME)/flip_current [expr {$stateArr(curr) / 10.0}]
|
||||
hset /sics/$pa(NAME)/flip_frequency $stateArr(freq)
|
||||
hset /sics/$pa(NAME)/flip_voltage $stateArr(voltage)
|
||||
hset /sics/$pa(NAME)/flip_on $stateArr(O)
|
||||
hsetprop /sics/$pa(NAME) targetFreq $stateArr(freq)
|
||||
hsetprop /sics/$pa(NAME) targetCurr [expr {$stateArr(curr) / 10.0}]
|
||||
|
||||
sct_rfgen poll /sics/$pa(NAME) $pa(INTERVAL)
|
||||
sct_rfgen write /sics/$pa(NAME)/set_flip_on
|
||||
}
|
||||
|
||||
if {$pa(TUNING)} {
|
||||
hfactory /sics/$pa(NAME)/set_current plain user float
|
||||
hfactory /sics/$pa(NAME)/set_frequency plain user int
|
||||
|
||||
hsetprop /sics/$pa(NAME)/set_current write ::scobj::rfgen::set_current /sics/$pa(NAME)
|
||||
hsetprop /sics/$pa(NAME)/set_frequency write ::scobj::rfgen::set_frequency /sics/$pa(NAME)
|
||||
|
||||
if {[SplitReply [rfgen_simulation]] == "false"} {
|
||||
sct_rfgen write /sics/$pa(NAME)/set_current
|
||||
sct_rfgen write /sics/$pa(NAME)/set_frequency
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,18 +0,0 @@
|
||||
fileeval $cfPath(beamline)/sct_flipper.tcl
|
||||
|
||||
# NOTE: opCurr is 10 * your operating current, ie if the current is 7.1 then opCurr = 71
|
||||
::scobj::rfgen::mkFlipper {
|
||||
name "flipper"
|
||||
address 1
|
||||
opCurr 71
|
||||
opFreq 407
|
||||
IP 137.157.202.86
|
||||
PORT 4001
|
||||
tuning 1
|
||||
interval 2
|
||||
currtol 1
|
||||
compCurr 1
|
||||
guideCurr 1
|
||||
thickness 1
|
||||
}
|
||||
|
||||
@@ -5,213 +5,6 @@ namespace eval motor {
|
||||
variable is_homing_list ""
|
||||
}
|
||||
|
||||
#namespace eval sample {
|
||||
# command select {int=0:8 sampid} {
|
||||
# SampleNum $sampid
|
||||
# }
|
||||
#}
|
||||
|
||||
##
|
||||
# @brief Beamstop select command
|
||||
# @param bs beamstop, 1,2,3,4,5 or 6
|
||||
# @param bx beam position in detector coordinates
|
||||
# @param bz beam position in detector coordinates
|
||||
# Given
|
||||
# (Xbf,Zbf) = beam pos in frame coords
|
||||
# (Xbd,Zbd) = beam pos in detector coords
|
||||
# (Xbbs, Zbbs) = beam pos in beamstop coords
|
||||
# (Xdf,Zdf) = detector pos in frame coords
|
||||
# (Xbsf,Zbsf) = beamstop pos in frame coords
|
||||
#
|
||||
# (Xbf,Zbf) = (Xdf+Xbd, Zdf+Zbd) = (Xbsf+Xbbs, Zbsf+Zbbs)
|
||||
# Origin of detector coords = frame origin
|
||||
#
|
||||
# Detector and beamstop motor readings with beamstop disk centers
|
||||
# overlapping over detector center mark.
|
||||
# Xdf = 264.542 (7283813) Zdf = 0
|
||||
# Xbbs = 296.291 (8054270)
|
||||
# Zbbs = 259.641 (13488244)
|
||||
# Xbd = dethw, Zbd = (dethh)
|
||||
#
|
||||
# 264.542+dethw = Xbsf+296.291
|
||||
# 0+dethh = Zbsf+259.641
|
||||
#
|
||||
# Xbsf = -31.749 + dethw, Zbsf = -259.641 + dethh
|
||||
proc selbs {bs {bx "UNDEF"} {bz "UNDEF"}} {
|
||||
set bsdriving false
|
||||
set dethw [expr {[SplitReply [detector_active_height_mm]]/2.0}]
|
||||
set dethh [expr {[SplitReply [detector_active_width_mm]]/2.0}]
|
||||
set Xbsf [expr -31.749 + $dethw]
|
||||
set Zbsf [expr -259.641 + $dethh]
|
||||
array set bsl [subst {
|
||||
1 [SplitReply [bs1 softlowerlim]]
|
||||
2 [SplitReply [bs2 softlowerlim]]
|
||||
3 [SplitReply [bs3 softlowerlim]]
|
||||
4 [SplitReply [bs4 softlowerlim]]
|
||||
5 [SplitReply [bs5 softlowerlim]]
|
||||
6 [SplitReply [bs6 softlowerlim]]
|
||||
}]
|
||||
if [ catch {
|
||||
switch $bs {
|
||||
"1" {
|
||||
set bsmot "bs1"
|
||||
set bs_target 93.20
|
||||
set bs_diameter 110
|
||||
set bsdownCmd "drive bs2 $bsl(2) bs3 $bsl(3) bs4 $bsl(4) bs5 $bsl(5) bs6 $bsl(6)"
|
||||
}
|
||||
"2" {
|
||||
set bsmot "bs2"
|
||||
set bs_target 86.84
|
||||
set bs_diameter 88
|
||||
set bsdownCmd "drive bs1 $bsl(1) bs3 $bsl(3) bs4 $bsl(4) bs5 $bsl(5) bs6 $bsl(6)"
|
||||
}
|
||||
"3" {
|
||||
set bsmot "bs3"
|
||||
set bs_target 93.35
|
||||
set bs_diameter 66
|
||||
set bsdownCmd "drive bs2 $bsl(2) bs1 $bsl(1) bs4 $bsl(4) bs5 $bsl(5) bs6 $bsl(6)"
|
||||
}
|
||||
"4" {
|
||||
set bsmot "bs4"
|
||||
set bs_target 86.85
|
||||
set bs_diameter 44
|
||||
set bsdownCmd "drive bs2 $bsl(2) bs3 $bsl(3) bs1 $bsl(1) bs5 $bsl(5) bs6 $bsl(6)"
|
||||
}
|
||||
"5" {
|
||||
set bsmot "bs5"
|
||||
set bs_target 93.27
|
||||
set bs_diameter 22
|
||||
set bsdownCmd "drive bs2 $bsl(2) bs3 $bsl(3) bs4 $bsl(4) bs1 $bsl(1) bs6 $bsl(6)"
|
||||
}
|
||||
"6" {
|
||||
set bsmot "bs6"
|
||||
set bs_target 86.98
|
||||
set bs_diameter 11
|
||||
set bsdownCmd "drive bs2 $bsl(2) bs3 $bsl(3) bs4 $bsl(4) bs5 $bsl(5) bs1 $bsl(1)"
|
||||
}
|
||||
default {
|
||||
error "beamstop selection must be an integer from 1 to 6"
|
||||
}
|
||||
}
|
||||
|
||||
set detoff_val [SplitReply [detoff]]
|
||||
|
||||
if {$bx == "UNDEF" || $bz == "UNDEF"} {
|
||||
statemon start selbs
|
||||
if {[info level] > 1} {statemon start [lindex [info level -1] 0]}
|
||||
set bsdriving true
|
||||
BeamStop -1
|
||||
BSdiam -1
|
||||
drive $bsmot $bs_target
|
||||
eval $bsdownCmd
|
||||
BeamStop $bs
|
||||
BSdiam $bs_diameter
|
||||
set bsdriving false
|
||||
statemon stop selbs
|
||||
if {[info level] > 1} {statemon stop [lindex [info level -1] 0]}
|
||||
} else {
|
||||
if { [string is double $bx] == false } {
|
||||
if { [string is double $bz] == false } {
|
||||
error "beam coordinates must be floats"
|
||||
}
|
||||
}
|
||||
set bsx_target [expr {$bx-$Xbsf+$detoff_val}]
|
||||
set bsz_target [expr {$bz-$Zbsf}]
|
||||
|
||||
statemon start selbs
|
||||
if {[info level] > 1} {statemon start [lindex [info level -1] 0]}
|
||||
set bsdriving true
|
||||
BeamStop -1
|
||||
BSdiam -1
|
||||
drive $bsmot $bs_target bsx $bsx_target bsz $bsz_target
|
||||
eval $bsdownCmd
|
||||
BeamStop $bs
|
||||
BSdiam $bs_diameter
|
||||
set bsdriving false
|
||||
statemon stop selbs
|
||||
if {[info level] > 1} {statemon stop [lindex [info level -1] 0]}
|
||||
}
|
||||
} msg ] {
|
||||
if {$bsdriving} {
|
||||
statemon stop selbs
|
||||
if {[info level] > 1} {statemon stop [lindex [info level -1] 0]}
|
||||
}
|
||||
return -code error $msg
|
||||
}
|
||||
}
|
||||
publish selbs user
|
||||
|
||||
#namespace eval beamstops {
|
||||
# command selbsn {int=1,2,3,4,5,6 bs} {
|
||||
# selbs $bs "UNDEF" "UNDEF"
|
||||
# }
|
||||
# command selbsxz {int=1,2,3,4,5,6 bs float bx float bz} {
|
||||
# selbs $bs $bx $bz
|
||||
# }
|
||||
#}
|
||||
|
||||
#namespace eval optics {
|
||||
# VarMake ::optics::select::section text user
|
||||
# VarMake ::optics::polarizer::in text user
|
||||
# VarMake ::optics::lens::selection text user
|
||||
|
||||
# command rotary_attenuator {int=0,15,45,90,180 angle} {
|
||||
# drive att $angle
|
||||
# }
|
||||
|
||||
# command entrance_aperture {
|
||||
# int=0,45,90,135,180,270 angle
|
||||
# } {
|
||||
# drive srce $angle
|
||||
# }
|
||||
|
||||
# TODO Do we need this
|
||||
# command sample_aperture {
|
||||
# int=25,50 size
|
||||
# text=circ,squ,open,rect shape
|
||||
# } {
|
||||
# SApXmm $size
|
||||
# SApZmm $size
|
||||
# SApShape $shape
|
||||
# }
|
||||
|
||||
##############################
|
||||
##
|
||||
# @brief The "guide" command uses a lookup table to setup the collimation system
|
||||
# @param row, selects a row from the guide configuration table
|
||||
#
|
||||
# eg\n
|
||||
# guide ga
|
||||
# command guide "
|
||||
# text=[join [array names ::optics::guide_configuration] , ] configuration
|
||||
# " {
|
||||
#
|
||||
# variable guide_configuration
|
||||
# variable guide_configuration_columns
|
||||
#
|
||||
# if [ catch {
|
||||
#
|
||||
# foreach {compselection position} $guide_configuration($configuration) {
|
||||
# foreach el $compselection guide $guide_configuration_columns {
|
||||
# lappend to_config $guide
|
||||
# lappend to_config [set ::optics::${guide}_map($el)]
|
||||
# }
|
||||
# ::optics::guide -set feedback status BUSY
|
||||
# set msg [eval "drive $to_config"]
|
||||
# EApPosY $position
|
||||
# }
|
||||
# GuideConfig $configuration
|
||||
# } message ] {
|
||||
# ::optics::guide -set feedback status IDLE
|
||||
# if {$::errorCode=="NONE"} {return $message}
|
||||
# return -code error $message
|
||||
# }
|
||||
# ::optics::guide -set feedback status IDLE
|
||||
# }
|
||||
# ::optics::guide -addfb text status
|
||||
# ::optics::guide -set feedback status IDLE
|
||||
#}
|
||||
|
||||
proc ::commands::isc_initialize {} {
|
||||
::commands::ic_initialize
|
||||
}
|
||||
|
||||
@@ -1,51 +1,4 @@
|
||||
# Author Jing Chen (jgn@ansto.gov.au)
|
||||
|
||||
source $cfPath(environment)/temperature/lakeshore340_common.tcl
|
||||
|
||||
# @brief Adds a lakeshore 340 temperature controller object.
|
||||
#
|
||||
# This must be called when the instrument configuration is loaded and before\n
|
||||
# the buildHDB function is called. Currently there is no way to add and remove\n
|
||||
# environment controllers and their hdb paths at runtime.
|
||||
#
|
||||
# @param tcn temperature controller name, the hdb name will be tcn_cntrl
|
||||
# @param mport, the moxa RS232 port number, ie 1,2,3,4
|
||||
#
|
||||
# Optional parameters, see lakeshore340_common.tcl for defaults in tc_dfltPar
|
||||
# @param tolerance, temperature controller tolerance
|
||||
# @param settle, settling time in seconds
|
||||
# @param range, lakeshore range
|
||||
# @param upperlimit, upper temperature limit Kelvin
|
||||
# @param lowerlimit, lower temperature limit Kelvin
|
||||
proc ::environment::temperature::add_ls340 {tcn tc_dfltURL mport args} {
|
||||
variable tc_dfltPar
|
||||
variable moxaPortMap
|
||||
if [catch {
|
||||
if {$tcn == "" || $mport == ""} {
|
||||
error "ERROR: You must provide a temperature controller name and moxa port number"
|
||||
}
|
||||
|
||||
array set tc_param [array get tc_dfltPar]
|
||||
|
||||
if {$args != ""} {
|
||||
array set tc_param $args
|
||||
foreach {nm v} $args {
|
||||
set tc_param($nm) $v
|
||||
}
|
||||
}
|
||||
set sim_mode [SplitReply [environment_simulation]]
|
||||
if {$sim_mode == "true"} {
|
||||
::environment::temperature::mkls340sim $tcn
|
||||
} else {
|
||||
::environment::temperature::mkls340 $tcn $tc_dfltURL $moxaPortMap($mport)
|
||||
foreach nm [array names tc_param] {
|
||||
$tcn $nm $tc_param($nm)
|
||||
}
|
||||
}
|
||||
|
||||
sicslist setatt $tcn environment_name ${tcn}_cntrl
|
||||
sicslist setatt $tcn long_name control_sensor_reading
|
||||
::environment::mkenvinfo $tcn {heateron {priv user} range {priv manager} }
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,33 +0,0 @@
|
||||
set hpaths [list experiment ]
|
||||
|
||||
# Maps devices (eg motors) to hipadaba paths.
|
||||
# obj name path
|
||||
set motor_hpath [list \
|
||||
aperture slits \
|
||||
attenuator attenuator \
|
||||
collimator collimator \
|
||||
detector detector \
|
||||
polarizer polarizer \
|
||||
sample sample ]
|
||||
|
||||
|
||||
# Configurable virtual motors
|
||||
# obj name path master_obj
|
||||
set cvirtmotor_hpath [list \
|
||||
ss1hg gap slits/1/horizontal [list left right]\
|
||||
ss1ho offset slits/1/horizontal [list left right]\
|
||||
ss1vg gap slits/1/vertical [list upper lower]\
|
||||
ss1vo offset slits/1/vertical [list upper lower]\
|
||||
ss2hg gap slits/2/horizontal [list left right]\
|
||||
ss2ho offset slits/2/horizontal [list left right]\
|
||||
ss2vg gap slits/2/vertical [list upper lower]\
|
||||
ss2vo offset slits/2/vertical [list upper lower]\
|
||||
ss3hg gap slits/3/horizontal [list left right]\
|
||||
ss3ho offset slits/3/horizontal [list left right]\
|
||||
ss3vg gap slits/3/vertical [list upper lower]\
|
||||
ss3vo offset slits/3/vertical [list upper lower]\
|
||||
ss4hg gap slits/4/horizontal [list left right]\
|
||||
ss4ho offset slits/4/horizontal [list left right]\
|
||||
ss4vg gap slits/4/vertical [list upper lower]\
|
||||
ss4vo offset slits/4/vertical [list upper lower]]
|
||||
|
||||
@@ -1,6 +0,0 @@
|
||||
# Detector voltage controller
|
||||
fileeval $cfPath(hmm)/sct_orhvps_common.tcl
|
||||
::scobj::dethvps::init ca1-lyrebird 4001 4.1
|
||||
dhv1 max 2600
|
||||
dhv1 lower 19
|
||||
dhv1 upper 57
|
||||
@@ -1,488 +0,0 @@
|
||||
# Ordela 21000N detector calibration
|
||||
|
||||
proc ord_get_pot { potxy potnumber } {
|
||||
for { set rsp "Bad" } { $rsp == "Bad" } { } {
|
||||
set potname [ format "%s%d" $potxy [expr $potnumber ^ 3] ]
|
||||
# set rspall [ dhv1 cmd P $potname ]
|
||||
set rspall [ sct_dhv1 transact "P $potname" ]
|
||||
set rsp [lindex [split $rspall " "] 1]
|
||||
}
|
||||
return $rsp
|
||||
}
|
||||
Publish ord_get_pot User
|
||||
|
||||
proc ord_set_pot { potxy potnumber potvalue } {
|
||||
set potname [ format "%s%d" $potxy [expr $potnumber ^ 3] ]
|
||||
# set rsp [ dhv1 cmd p $potname $potvalue ]
|
||||
set rsp [ sct_dhv1 transact "p $potname $potvalue" ]
|
||||
return $rsp
|
||||
}
|
||||
Publish ord_set_pot User
|
||||
|
||||
set ord_pot_all_x ""
|
||||
Publish ord_pot_all_x User
|
||||
set ord_pot_all_y ""
|
||||
Publish ord_pot_all_y User
|
||||
set ord_pot_all_xy ""
|
||||
Publish ord_pot_all_xy User
|
||||
|
||||
proc ord_get_pot_all { } {
|
||||
global ord_pot_all_x
|
||||
global ord_pot_all_y
|
||||
global ord_pot_all_xy
|
||||
clientput " Reading Ordela 21000N pots, please wait..."
|
||||
set ord_pot_all_x ""
|
||||
set ord_pot_all_y ""
|
||||
for { set ixy 0 } { $ixy <= 191 } { incr ixy } {
|
||||
lappend ord_pot_all_x [ord_get_pot x $ixy]
|
||||
lappend ord_pot_all_y [ord_get_pot y $ixy]
|
||||
}
|
||||
set ord_pot_all_xy [ format "%s\n%s\n" $ord_pot_all_x $ord_pot_all_y ]
|
||||
clientput " All pots read. Current x and y pot settings are shown below:"
|
||||
return $ord_pot_all_xy
|
||||
}
|
||||
Publish ord_get_pot_all User
|
||||
|
||||
proc ord_set_pot_all { } {
|
||||
global ord_pot_all_x
|
||||
global ord_pot_all_y
|
||||
clientput " Writing Ordela 21000N pots, please wait..."
|
||||
set rspx ""
|
||||
for { set ixy 0 } { $ixy <= 191 } { incr ixy } {
|
||||
lappend rspx [ord_set_pot x $ixy [lindex $ord_pot_all_x $ixy] ]
|
||||
}
|
||||
set rspy ""
|
||||
for { set ixy 0 } { $ixy <= 191 } { incr ixy } {
|
||||
lappend rspy [ord_set_pot y $ixy [lindex $ord_pot_all_y $ixy] ]
|
||||
}
|
||||
clientput " All pots written. x and y pot setting responses are shown below:"
|
||||
set rsp [ format "%s\n%s\n" $rspx $rspy ]
|
||||
return $rsp
|
||||
}
|
||||
Publish ord_set_pot_all User
|
||||
|
||||
proc ord_set_pot_all_const_range_x_y { xy ord_pot_all_x_y pot_l s_x_y pot_h } {
|
||||
global $ord_pot_all_x_y
|
||||
set $ord_pot_all_x_y ""
|
||||
if { $s_x_y <= 0 } {
|
||||
clientput " Applying constant value" $pot_h "to all" $xy "pots."
|
||||
} elseif { $s_x_y >= 192 } {
|
||||
clientput " Applying constant value" $pot_l "to all" $xy "pots."
|
||||
} else {
|
||||
clientput " Applying constant value" $pot_l "to" $xy "pots 0 to" [expr $s_x_y - 1] "and" $pot_h "to" $xy "pots" $s_x_y "to 191."
|
||||
}
|
||||
for { set ixy 0 } { $ixy <= 191 } { incr ixy } {
|
||||
if { $ixy < $s_x_y } {
|
||||
set pot_value_x_y $pot_l
|
||||
} else {
|
||||
set pot_value_x_y $pot_h
|
||||
}
|
||||
lappend $ord_pot_all_x_y $pot_value_x_y
|
||||
}
|
||||
}
|
||||
|
||||
proc ord_set_pot_all_const_range_xy { pot_l_x s_x pot_h_x pot_l_y s_y pot_h_y } {
|
||||
global ord_pot_all_x
|
||||
global ord_pot_all_y
|
||||
ord_set_pot_all_const_range_x_y x ord_pot_all_x $pot_l_x $s_x $pot_h_x
|
||||
ord_set_pot_all_const_range_x_y y ord_pot_all_y $pot_l_y $s_y $pot_h_y
|
||||
clientput $ord_pot_all_x
|
||||
clientput $ord_pot_all_y
|
||||
}
|
||||
Publish ord_set_pot_all_const_range_xy User
|
||||
|
||||
proc ord_set_pot_all_const_range { pot_l_x s_x pot_h_x pot_l_y s_y pot_h_y } {
|
||||
ord_set_pot_all_const_range_xy $pot_l_x $s_x $pot_h_x $pot_l_y $s_y $pot_h_y
|
||||
return [ord_set_pot_all]
|
||||
}
|
||||
Publish ord_set_pot_all_const_range User
|
||||
|
||||
proc ord_set_pot_all_const_xy { pot_value_x pot_value_y } {
|
||||
ord_set_pot_all_const_range_xy $pot_value_x 0 $pot_value_x $pot_value_y 0 $pot_value_y
|
||||
return [ord_set_pot_all]
|
||||
}
|
||||
Publish ord_set_pot_all_const_xy User
|
||||
|
||||
proc ord_set_pot_all_const { pot_value } {
|
||||
ord_set_pot_all_const_range_xy $pot_value 0 $pot_value $pot_value 0 $pot_value
|
||||
return [ord_set_pot_all]
|
||||
}
|
||||
Publish ord_set_pot_all_const User
|
||||
|
||||
proc ord_save_pot_all { filename } {
|
||||
global ord_pot_all_xy
|
||||
set fh [ open $filename w ]
|
||||
puts $fh $ord_pot_all_xy
|
||||
close $fh
|
||||
clientput " All pot settings saved to file."
|
||||
}
|
||||
Publish ord_save_pot_all User
|
||||
|
||||
proc ord_load_pot_all { filename } {
|
||||
global ord_pot_all_x
|
||||
global ord_pot_all_y
|
||||
global ord_pot_all_xy
|
||||
set fh [ open $filename ]
|
||||
gets $fh ord_pot_all_x
|
||||
gets $fh ord_pot_all_y
|
||||
set ord_pot_all_xy [ format "%s\n%s\n" $ord_pot_all_x $ord_pot_all_y ]
|
||||
close $fh
|
||||
clientput " All pot settings loaded from file."
|
||||
clientput "x settings:" $ord_pot_all_x
|
||||
clientput "y settings:" $ord_pot_all_y
|
||||
}
|
||||
Publish ord_load_pot_all User
|
||||
|
||||
set histogram_xy ""
|
||||
set histogram_x ""
|
||||
set histogram_y ""
|
||||
|
||||
# Calibration procedure should not include data from edges of the detector pattern in corresponding 2D histogram.
|
||||
# The set values can be viewed/adjusted using the ord_get_cal_roi and ord_set_bs_pos functions provided below.
|
||||
set roi_x_l 24
|
||||
set roi_x_h 167
|
||||
set roi_y_l 24
|
||||
set roi_y_h 167
|
||||
|
||||
proc ord_get_histogram_xy { bs_x_l bs_x_h bs_y_l bs_y_h roi_x_l roi_x_h roi_y_l roi_y_h } {
|
||||
# Use data from within the x,y ROI (inclusive) to calculate 2D histograms.
|
||||
# Excludes the beamstop region from the histogram calculations.
|
||||
# Note the ROI and beamstop coords are in terms of histogram server coord system
|
||||
# but the result x and y histograms are in detector coordinate system (match pot order).
|
||||
# Also note that when calculating the x and y 1D histogram, it includes data from the y or x ROI respectively
|
||||
# and excludes data from the BS region. (i.e. x histogram is computed by summing in y across the y ROI,
|
||||
# but excludes the portion of y occupied by the beamstop). The calculation is done in this way so that
|
||||
# the result is as uniform as possible in x and y.
|
||||
global histogram_xy
|
||||
global histogram_x
|
||||
global histogram_y
|
||||
clientput "Retrieving 2D xy histogram..."
|
||||
set histogram_xy [ lreplace [ split [ hmm get 1 ] ] 0 1 ]
|
||||
if { ($bs_x_l > $bs_x_h || $bs_y_l > $bs_y_h) && $roi_x_l == 0 && $roi_x_h == 191 && $roi_y_l == 0 && $roi_y_h == 191 } {
|
||||
set get_full_histogram 1
|
||||
clientput "Calculating 2D histograms over full detector area..."
|
||||
set bs_x_l 1
|
||||
set bs_x_h 0
|
||||
set bs_y_l 1
|
||||
set bs_y_h 0
|
||||
} else {
|
||||
set get_full_histogram 0
|
||||
clientput "Calculating 2D histograms excluding beamstop area x =" $bs_x_l "to" $bs_x_h "and y =" $bs_y_l "to" $bs_y_h "..."
|
||||
clientput "Histograms ROI is x =" $roi_x_l "to" $roi_x_h "(for y histogram) and y =" $roi_y_l "to" $roi_y_h "(for x histogram)."
|
||||
}
|
||||
set histogram_memory_x ""
|
||||
set histogram_memory_y ""
|
||||
for { set ia 0 } { $ia <= 191 } { incr ia } {
|
||||
set sum_x 0
|
||||
set sum_y 0
|
||||
# NOTE: In the sum loops below, do NOT include the edges! Too unreliable. Sum in the ROI only instead.
|
||||
for { set ib $roi_x_l } { $ib < $bs_x_l } { incr ib } {
|
||||
set sum_x [expr $sum_x + [lindex $histogram_xy [expr $ib + $ia * 192] ]]
|
||||
}
|
||||
for { set ib [expr $bs_x_h + 1] } { $ib <= $roi_x_h } { incr ib } {
|
||||
set sum_x [expr $sum_x + [lindex $histogram_xy [expr $ib + $ia * 192] ]]
|
||||
}
|
||||
for { set ib $roi_y_l } { $ib < $bs_y_l } { incr ib } {
|
||||
set sum_y [expr $sum_y + [lindex $histogram_xy [expr $ia + $ib * 192] ]]
|
||||
}
|
||||
for { set ib [expr $bs_y_h + 1] } { $ib <= $roi_y_h } { incr ib } {
|
||||
set sum_y [expr $sum_y + [lindex $histogram_xy [expr $ia + $ib * 192] ]]
|
||||
}
|
||||
lappend histogram_memory_x $sum_y
|
||||
lappend histogram_memory_y $sum_x
|
||||
}
|
||||
#
|
||||
# If x and y need to be swapped or reordered, do it in the loop below.
|
||||
# (histo server raw data x,y order matches pot order)
|
||||
set histogram_x ""
|
||||
set histogram_y ""
|
||||
for { set ixy 0 } { $ixy <= 191 } { incr ixy } {
|
||||
lappend histogram_x [lindex $histogram_memory_y [expr $ixy]]
|
||||
lappend histogram_y [lindex $histogram_memory_x [expr 191 - $ixy]]
|
||||
}
|
||||
#
|
||||
#
|
||||
if { $get_full_histogram == 1 } {
|
||||
clientput "Calculated x and y histograms over entire detector area. Data:"
|
||||
} else {
|
||||
clientput "Calculated x and y histograms for ROI, excluding beamstop area. Data:"
|
||||
}
|
||||
set rsp [ format "%s\n%s\n" $histogram_x $histogram_y ]
|
||||
return $rsp
|
||||
}
|
||||
Publish ord_get_histogram_xy User
|
||||
|
||||
# Beamstop and spill nominally occupies the center 1/4 of the detector pattern.
|
||||
# The set values can be viewed/adjusted using the ord_get_bs_pos and ord_set_bs_pos functions provided below.
|
||||
set bss_x_l 72
|
||||
set bss_x_h 120
|
||||
set bss_y_l 72
|
||||
set bss_y_h 120
|
||||
|
||||
proc ord_get_bs_pos { } {
|
||||
global bss_x_l
|
||||
global bss_x_h
|
||||
global bss_y_l
|
||||
global bss_y_h
|
||||
clientput "The current beamstop position settings (in histogram server xy coordinates) are: xl =" $bss_x_l "xh =" $bss_x_h$
|
||||
}
|
||||
Publish ord_get_bs_pos User
|
||||
|
||||
proc ord_set_bs_pos { bss_x_l_new bss_x_h_new bss_y_l_new bss_y_h_new } {
|
||||
global bss_x_l
|
||||
global bss_x_h
|
||||
global bss_y_l
|
||||
global bss_y_h
|
||||
set bss_x_l $bss_x_l_new
|
||||
set bss_x_h $bss_x_h_new
|
||||
set bss_y_l $bss_y_l_new
|
||||
set bss_y_h $bss_y_h_new
|
||||
return [ord_get_bs_pos]
|
||||
}
|
||||
Publish ord_set_bs_pos User
|
||||
|
||||
# Calibration procedure should not include data from edges of the detector pattern in corresponding 2D histogram.
|
||||
# The set values can be viewed/adjusted using the ord_get_cal_roi and ord_set_bs_pos functions provided below.
|
||||
set roi_x_l 24
|
||||
set roi_x_h 167
|
||||
set roi_y_l 24
|
||||
set roi_y_h 167
|
||||
|
||||
proc ord_get_roi_pos { } {
|
||||
global roi_x_l
|
||||
global roi_x_h
|
||||
global roi_y_l
|
||||
global roi_y_h
|
||||
clientput "The current histogram ROI settings (in histogram server xy coordinates) are: xl =" $roi_x_l "xh =" $roi_x_h "yl =" $roi_y_l "yh =" $roi_y_h
|
||||
}
|
||||
Publish ord_get_roi_pos User
|
||||
|
||||
proc ord_set_roi_pos { roi_x_l_new roi_x_h_new roi_y_l_new roi_y_h_new } {
|
||||
global roi_x_l
|
||||
global roi_x_h
|
||||
global roi_y_l
|
||||
global roi_y_h
|
||||
set roi_x_l $roi_x_l_new
|
||||
set roi_x_h $roi_x_h_new
|
||||
set roi_y_l $roi_y_l_new
|
||||
set roi_y_h $roi_y_h_new
|
||||
return [ord_get_roi_pos]
|
||||
}
|
||||
Publish ord_set_roi_pos User
|
||||
|
||||
proc ord_get_histogram_xy_bs { } {
|
||||
global bss_x_l
|
||||
global bss_x_h
|
||||
global bss_y_l
|
||||
global bss_y_h
|
||||
global roi_x_l
|
||||
global roi_x_h
|
||||
global roi_y_l
|
||||
global roi_y_h
|
||||
return [ ord_get_histogram_xy $bss_x_l $bss_x_h $bss_y_l $bss_y_h $roi_x_l $roi_x_h $roi_y_l $roi_y_h ]
|
||||
}
|
||||
Publish ord_get_histogram_xy_bs User
|
||||
|
||||
proc ord_get_histogram_xy_all { } {
|
||||
return [ ord_get_histogram_xy 1 0 1 0 0 191 0 191 ]
|
||||
}
|
||||
Publish ord_get_histogram_xy_all User
|
||||
|
||||
set histogram_min_x ""
|
||||
set histogram_min_y ""
|
||||
set histogram_max_x ""
|
||||
set histogram_max_y ""
|
||||
set histogram_mean_x ""
|
||||
set histogram_mean_y ""
|
||||
|
||||
proc ord_calc_hist_mmm_xy { } {
|
||||
# Calculates min, max and mean of histogram values.
|
||||
# NOTE: Because of edge effects in the detector, three of the edges return
|
||||
# very high or low values. In order to stop these from dragging the mean
|
||||
# high or low, they are excluded from the min/max/mean calculation entirely.
|
||||
global histogram_x
|
||||
global histogram_y
|
||||
global histogram_min_x
|
||||
global histogram_min_y
|
||||
global histogram_max_x
|
||||
global histogram_max_y
|
||||
global histogram_mean_x
|
||||
global histogram_mean_y
|
||||
global bss_x_l
|
||||
global bss_x_h
|
||||
global bss_y_l
|
||||
global bss_y_h
|
||||
# NOTE: Ignore the edges entirely, as they are not reliable.
|
||||
set histogram_mean_x 0
|
||||
set histogram_mean_y 0
|
||||
for { set ixy 1 } { $ixy <= 190 } { incr ixy } {
|
||||
set histogram_x_val [lindex $histogram_x $ixy]
|
||||
set histogram_y_val [lindex $histogram_y $ixy]
|
||||
if { $ixy == 1 } { # NOTE edge at 0 is ignored
|
||||
set histogram_min_x $histogram_x_val
|
||||
set histogram_min_y $histogram_y_val
|
||||
set histogram_max_x $histogram_x_val
|
||||
set histogram_max_y $histogram_y_val
|
||||
} else {
|
||||
if {$histogram_x_val < $histogram_min_x } {
|
||||
set histogram_min_x $histogram_x_val
|
||||
}
|
||||
if {$histogram_y_val < $histogram_min_y } {
|
||||
set histogram_min_y $histogram_y_val
|
||||
}
|
||||
if {$histogram_x_val > $histogram_max_x } {
|
||||
set histogram_max_x $histogram_x_val
|
||||
}
|
||||
if {$histogram_y_val > $histogram_max_y } {
|
||||
set histogram_max_y $histogram_y_val
|
||||
}
|
||||
}
|
||||
set histogram_mean_x [expr $histogram_mean_x + $histogram_x_val ]
|
||||
set histogram_mean_y [expr $histogram_mean_y + $histogram_y_val ]
|
||||
}
|
||||
# NOTE beamstop region and edges are not included.
|
||||
# ALSO NOTE we sum x histo over y, but x and y are transposed when the histo is retrieved,
|
||||
# so we divide x histo values by span_x and y by span_y!
|
||||
# set span_x [expr 190 - ( $bss_x_h - $bss_x_l ) ]
|
||||
# set span_y [expr 190 - ( $bss_y_h - $bss_y_l ) ]
|
||||
# if { $bss_x_l == 0 } { incr span_x }
|
||||
# if { $bss_x_h == 191 } { incr span_x }
|
||||
# if { $bss_y_l == 0 } { incr span_y }
|
||||
# if { $bss_y_h == 191 } { incr span_y }
|
||||
set span_x 190
|
||||
set span_y 190
|
||||
set histogram_mean_x [expr double($histogram_mean_x) / double($span_x) ]
|
||||
set histogram_mean_y [expr double($histogram_mean_y) / double($span_y) ]
|
||||
clientput "Calculated histogram means: mx =" $histogram_mean_x "and my =" $histogram_mean_y "(should be
|
||||
roughly equal if bs window is square)."
|
||||
}
|
||||
Publish ord_calc_hist_mmm_xy User
|
||||
|
||||
proc ord_calc_pot { pot_in histogram_value histogram_mean CP_divider add_deviation } {
|
||||
set CP 0.25
|
||||
set histogram_deviation [expr double($histogram_value) / double($histogram_mean) - 1.]
|
||||
set pot_out [ expr double($pot_in) - $histogram_deviation * $CP * 100. / $CP_divider ]
|
||||
set pot_out [ expr int($pot_out + double($add_deviation) + 0.5) ]
|
||||
if { $pot_out < 0 } {
|
||||
set pot_out 0
|
||||
} elseif { $pot_out > 63 } {
|
||||
set pot_out 63
|
||||
}
|
||||
return $pot_out
|
||||
}
|
||||
Publish ord_calc_pot User
|
||||
|
||||
proc ord_calc_pot_all_xy { CP_divider desiredpotsmidrange_x desiredpotsmidrange_y } {
|
||||
global histogram_x
|
||||
global histogram_y
|
||||
global histogram_mean_x
|
||||
global histogram_mean_y
|
||||
global ord_pot_all_x
|
||||
global ord_pot_all_y
|
||||
clientput "Calculating new pot settings based on old pot settings and histogram data..."
|
||||
set ord_pot_all_x_new ""
|
||||
set ord_pot_all_y_new ""
|
||||
set ord_pot_dev_av_x 0
|
||||
set ord_pot_dev_av_y 0
|
||||
set ord_pot_dev_max_x 0
|
||||
set ord_pot_dev_max_y 0
|
||||
# Find current mean pot values. Do NOT include the edge pots.
|
||||
set ord_pot_mean_x 0
|
||||
set ord_pot_mean_y 0
|
||||
for { set ixy 1 } { $ixy <= 190 } { incr ixy } {
|
||||
set ord_pot_mean_x [expr $ord_pot_mean_x + [lindex $ord_pot_all_x $ixy]]
|
||||
set ord_pot_mean_y [expr $ord_pot_mean_y + [lindex $ord_pot_all_y $ixy]]
|
||||
}
|
||||
set ord_pot_mean_x [expr double($ord_pot_mean_x) / 190.]
|
||||
set ord_pot_mean_y [expr double($ord_pot_mean_y) / 190.]
|
||||
# Calculate additional deviation to apply during new pot value calculation,
|
||||
# to keep pot average close to desired mid range.
|
||||
set ord_pot_add_dev_x [expr double($desiredpotsmidrange_x) - $ord_pot_mean_x]
|
||||
set ord_pot_add_dev_y [expr double($desiredpotsmidrange_y) - $ord_pot_mean_y]
|
||||
# Find all new pot values.
|
||||
for { set ixy 0 } { $ixy <= 191 } { incr ixy } {
|
||||
# clientput "Index" $ixy "x pot value" [lindex $ord_pot_all_x $ixy]
|
||||
# clientput "Index" $ixy "histogram x value" [lindex $histogram_x $ixy]
|
||||
# clientput "Index" $ixy "x pot value" $histogram_mean_x
|
||||
# clientput "Index" $ixy "y pot value" [lindex $ord_pot_all_y $ixy]
|
||||
# clientput "Index" $ixy "histogram y value" [lindex $histogram_y $ixy]
|
||||
# clientput "Index" $ixy "y pot value" $histogram_mean_y
|
||||
set ord_pot_old_x [lindex $ord_pot_all_x $ixy]
|
||||
set ord_pot_old_y [lindex $ord_pot_all_y $ixy]
|
||||
set ord_pot_new_x [ ord_calc_pot $ord_pot_old_x [lindex $histogram_x $ixy] $histogram_mean_x $CP_divider $ord_pot_add_dev_x ]
|
||||
set ord_pot_new_y [ ord_calc_pot $ord_pot_old_y [lindex $histogram_y $ixy] $histogram_mean_y $CP_divider $ord_pot_add_dev_y ]
|
||||
lappend ord_pot_all_x_new $ord_pot_new_x
|
||||
lappend ord_pot_all_y_new $ord_pot_new_y
|
||||
# Also get some stats on deviations (just take this as absolute)
|
||||
set ord_pot_dev_x [ expr abs ( $ord_pot_new_x - $ord_pot_old_x ) ]
|
||||
set ord_pot_dev_y [ expr abs ( $ord_pot_new_y - $ord_pot_old_y ) ]
|
||||
set ord_pot_dev_av_x [ expr $ord_pot_dev_av_x + $ord_pot_dev_x ]
|
||||
set ord_pot_dev_av_y [ expr $ord_pot_dev_av_y + $ord_pot_dev_y ]
|
||||
if { $ord_pot_dev_x > $ord_pot_dev_max_x } {
|
||||
set ord_pot_dev_max_x $ord_pot_dev_x
|
||||
}
|
||||
if { $ord_pot_dev_y > $ord_pot_dev_max_y } {
|
||||
set ord_pot_dev_max_y $ord_pot_dev_y
|
||||
}
|
||||
}
|
||||
set ord_pot_dev_av_x [ expr $ord_pot_dev_av_x / 192. ]
|
||||
set ord_pot_dev_av_y [ expr $ord_pot_dev_av_y / 192. ]
|
||||
clientput "Average deviations: x =" $ord_pot_dev_av_x "and y =" $ord_pot_dev_av_y
|
||||
clientput "Maximum deviations: x =" $ord_pot_dev_max_x "and y =" $ord_pot_dev_max_y
|
||||
#
|
||||
set ord_pot_all_x $ord_pot_all_x_new
|
||||
set ord_pot_all_y $ord_pot_all_y_new
|
||||
set ord_pot_all_xy [ format "%s\n%s\n" $ord_pot_all_x $ord_pot_all_y ]
|
||||
return $ord_pot_all_xy
|
||||
}
|
||||
Publish ord_calc_pot_all_xy User
|
||||
|
||||
proc ord_calibrate_iterate { CP_divider desiredpotsmidrange_x desiredpotsmidrange_y iteration } {
|
||||
# For this to work we must first read pot values and the x and y histograms.
|
||||
# Note the beamstop location is hard coded - position detector so that beamstop image is in the specified range
|
||||
clientput [ord_get_histogram_xy_bs]
|
||||
clientput [ord_calc_hist_mmm_xy]
|
||||
# if { $iteration == 1 } {
|
||||
# clientput [ord_get_pot_all] ## while iterating, the pot values are in the memory anyway so don't read
|
||||
# }
|
||||
clientput [ord_calc_pot_all_xy $CP_divider $desiredpotsmidrange_x $desiredpotsmidrange_y]
|
||||
clientput [ord_set_pot_all]
|
||||
}
|
||||
|
||||
proc ord_calibrate { CP_divider desiredpotsmidrange_x desiredpotsmidrange_y } {
|
||||
clientput [ord_get_pot_all]
|
||||
ord_calibrate_iterate $CP_divider $desiredpotsmidrange_x $desiredpotsmidrange_y 1
|
||||
}
|
||||
Publish ord_calibrate User
|
||||
|
||||
proc ord_calibrate_auto { CP_divider desiredpotsmidrange_x desiredpotsmidrange_y resetallpotsmidrange iterations acqtime } {
|
||||
#
|
||||
if { $resetallpotsmidrange == 1 } {
|
||||
clientput [ord_set_pot_all_const_xy $desiredpotsmidrange_x $desiredpotsmidrange_y ]
|
||||
} else {
|
||||
clientput [ord_get_pot_all]
|
||||
}
|
||||
#
|
||||
for { set iteration 1 } { $iteration <= $iterations } { incr iteration } {
|
||||
clientput "*** Commencing detector calibration iteration" $iteration
|
||||
# NOTE: Assumes the histogram memory is set up in its DEFAULT state
|
||||
# (that which SICS configures, but perhaps including HISTOGRAM_TRANSPOSE_RAW_XY=ENABLE).
|
||||
# At 9/08 the configuration is HISTOGRAM_TRANSPOSE_RAW_XY=ENABLE, X OAT flipped, Y OAT non-flipped.
|
||||
# Modify ordering in the ord_get_histogram_xy routine as needed.
|
||||
# Alternately reconfigure transpose and OAT flipping here, so we get what we expect...
|
||||
# (but this might not get put back by SICS so it's better not to)
|
||||
# dhv1 cmd d # Diagnostic mode - CD turned off
|
||||
histmem stop
|
||||
histmem mode time
|
||||
histmem preset $acqtime
|
||||
histmem pause # NOTE - start in paused mode - server sends reset to Ordela first
|
||||
# dhv1 cmd d # Place in diagnostic mode - will stay in this mode since reset won't occur on start, from paused
|
||||
clientput [histmem start block]
|
||||
# wait $acqtime # Can't figure out how to make histmem block, so just wait
|
||||
clientput [histmem stop]
|
||||
# dhv1 cmd n # Normal mode - CD turned back on
|
||||
clientput [ord_calibrate_iterate $CP_divider $desiredpotsmidrange_x $desiredpotsmidrange_y $iteration ]
|
||||
clientput "*** Detector calibration iteration" $iteration "completed."
|
||||
}
|
||||
}
|
||||
Publish ord_calibrate_auto User
|
||||
@@ -1,58 +1,43 @@
|
||||
# Author Jing Chen (jgn@ansto.gove.au)
|
||||
# Note: all following functions's bodies need to be implemented in real Taipan deployment
|
||||
|
||||
source $cfPath(hmm)/hmm_configuration_common_1.tcl
|
||||
set sim_mode [SplitReply [hmm_simulation]]
|
||||
|
||||
proc ::histogram_memory::init_OAT_TABLE {} {
|
||||
if [ catch {
|
||||
# We don't need a MAX_CHAN parameter for time because the time channel
|
||||
# is scaled by calling the ::histogram_memory::clock_scale function
|
||||
OAT_TABLE X -setdata MAX_CHAN 192
|
||||
OAT_TABLE Y -setdata MAX_CHAN 192
|
||||
OAT_TABLE X -setdata BMIN -0.5
|
||||
OAT_TABLE X -setdata BMAX 191.5
|
||||
OAT_TABLE Y -setdata BMIN -0.5
|
||||
OAT_TABLE Y -setdata BMAX 191.5
|
||||
|
||||
OAT_TABLE -set X { 191.5 190.5 } NXC 192 Y { -0.5 0.5 } NYC 192 T { 0 20000 } NTC 1
|
||||
} message ] {
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
proc ::histogram_memory::pre_count {} {}
|
||||
proc ::histogram_memory::post_count {} {}
|
||||
proc ::histogram_memory::isc_initialize {} {
|
||||
# Instrument specific X and Y dimension names
|
||||
variable INST_NXC "oat_nxc_eff"
|
||||
variable INST_NYC "oat_nyc_eff"
|
||||
#variable INST_NXC "oat_nxc_eff"
|
||||
#variable INST_NYC "oat_nyc_eff"
|
||||
|
||||
if [ catch {
|
||||
::histogram_memory::init_hmm_objs
|
||||
if {$::sim_mode == "true"} {
|
||||
hmm configure oat_ntc_eff 1
|
||||
hmm configure $INST_NYC 127
|
||||
hmm configure $INST_NXC 127
|
||||
#hmm configure oat_ntc_eff 1
|
||||
#hmm configure $INST_NYC 127
|
||||
#hmm configure $INST_NXC 127
|
||||
}
|
||||
BAT_TABLE -init
|
||||
CAT_TABLE -init
|
||||
SAT_TABLE -init
|
||||
OAT_TABLE -init
|
||||
FAT_TABLE -init
|
||||
#BAT_TABLE -init
|
||||
#CAT_TABLE -init
|
||||
#SAT_TABLE -init
|
||||
#OAT_TABLE -init
|
||||
#FAT_TABLE -init
|
||||
::histogram_memory::ic_initialize
|
||||
|
||||
detector_active_height_mm [expr 5.08 * 192]
|
||||
detector_active_width_mm [expr 5.08 * 192]
|
||||
detector_active_height_mm lock
|
||||
detector_active_width_mm lock
|
||||
#detector_active_height_mm [expr 5.08 * 192]
|
||||
#detector_active_width_mm [expr 5.08 * 192]
|
||||
#detector_active_height_mm lock
|
||||
#detector_active_width_mm lock
|
||||
|
||||
# hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
|
||||
# hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
|
||||
# hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
|
||||
# hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
|
||||
::histogram_memory::init_OAT_TABLE
|
||||
::histogram_memory::upload_config Filler_defaults
|
||||
|
||||
set ::histogram_memory::histmem_axes(HOR) /instrument/detector/x_pixel_offset
|
||||
set ::histogram_memory::histmem_axes(VER) /instrument/detector/y_pixel_offset
|
||||
#set ::histogram_memory::histmem_axes(HOR) /instrument/detector/x_pixel_offset
|
||||
#set ::histogram_memory::histmem_axes(VER) /instrument/detector/y_pixel_offset
|
||||
} message ] {
|
||||
return -code error $message
|
||||
}
|
||||
|
||||
@@ -1,22 +0,0 @@
|
||||
mot_name=xxx
|
||||
mot_units=xxx
|
||||
mot_long_name=xxx
|
||||
#--------------- NXmonochromator
|
||||
nxcrystal_mot=/$(entryName),NXentry/$(inst),NXinstrument/$(monochromator),NXcrystal/SDS $(mot_name) -type NX_FLOAT32 -attr {units,$(mot_units)} -attr {long_name,$(mot_long_name)}
|
||||
#XXX add units command to configurable virtual motors.
|
||||
mth=/$(entryName),NXentry/$(inst),NXinstrument/$(monochromator),NXcrystal/SDS mth -type NX_FLOAT32 -attr {units,degree} -attr {long_name,mth}
|
||||
#--------------- NXsample
|
||||
nxsample_mot=/$(entryName),NXentry/sample,NXsample/SDS $(mot_name) -type NX_FLOAT32 -attr {units,$(mot_units)} -attr {long_name,$(mot_long_name)}
|
||||
#XXX add units command to configurable virtual motors.
|
||||
sth=/$(entryName),NXentry/sample,NXsample/SDS sth -type NX_FLOAT32 -attr {units,degree} -attr {long_name,sth}
|
||||
# Slit motors
|
||||
nxfilter_mot=/$(entryName),NXentry/slits,NXfilter/SDS $(mot_name) -type NX_FLOAT32 -attr {units,$(mot_units)} -attr {long_name,$(mot_long_name)}
|
||||
#XXX add units command to configurable virtual motors.
|
||||
ss1vg=/$(entryName),NXentry/slits,NXfilter/SDS ss1vg -type NX_FLOAT32 -attr {units,degree} -attr {long_name,ss1vg}
|
||||
ss1vo=/$(entryName),NXentry/slits,NXfilter/SDS ss1vo -type NX_FLOAT32 -attr {units,degree} -attr {long_name,ss1vo}
|
||||
ss1hg=/$(entryName),NXentry/slits,NXfilter/SDS ss1hg -type NX_FLOAT32 -attr {units,degree} -attr {long_name,ss1hg}
|
||||
ss1ho=/$(entryName),NXentry/slits,NXfilter/SDS ss1ho -type NX_FLOAT32 -attr {units,degree} -attr {long_name,ss1ho}
|
||||
ss2vg=/$(entryName),NXentry/slits,NXfilter/SDS ss2vg -type NX_FLOAT32 -attr {units,degree} -attr {long_name,ss2vg}
|
||||
ss2vo=/$(entryName),NXentry/slits,NXfilter/SDS ss2vo -type NX_FLOAT32 -attr {units,degree} -attr {long_name,ss2vo}
|
||||
ss2hg=/$(entryName),NXentry/slits,NXfilter/SDS ss2hg -type NX_FLOAT32 -attr {units,degree} -attr {long_name,ss2hg}
|
||||
ss2ho=/$(entryName),NXentry/slits,NXfilter/SDS ss2ho -type NX_FLOAT32 -attr {units,degree} -attr {long_name,ss2ho}
|
||||
@@ -1,13 +1,4 @@
|
||||
source $cfPath(nexus)/nxscripts_common_1.tcl
|
||||
proc ::nexus::isc_initialize {} {
|
||||
if {0} {
|
||||
variable histmem_filetype_spec
|
||||
foreach spec [array names histmem_filetype_spec] {
|
||||
lappend histmem_filetype_spec($spec) link {aux_data 3 LambdaA}
|
||||
lappend histmem_filetype_spec($spec) link {aux_data 4 Transmission}
|
||||
lappend histmem_filetype_spec($spec) link {aux_data 5 ::histogram_memory::x_bin}
|
||||
lappend histmem_filetype_spec($spec) link {aux_data 6 ::histogram_memory::y_bin}
|
||||
}
|
||||
}
|
||||
::nexus::ic_initialize
|
||||
}
|
||||
|
||||
@@ -1,94 +0,0 @@
|
||||
namespace eval optics {
|
||||
array set AttRotLookupTable {
|
||||
0 { 0.0 1 }
|
||||
30 { 1.3 0.498782 }
|
||||
60 { 3.3 0.176433 }
|
||||
90 { 4.9 0.0761367 }
|
||||
120 { 6.4 0.0353985 }
|
||||
150 { 8.3 0.0137137 }
|
||||
180 { 9.6 0.00614167 }
|
||||
210 {11.2 0.00264554 }
|
||||
240 {13.1 0.000994504 }
|
||||
270 {15.0 0.000358897 }
|
||||
300 {18.0 7.2845e-05 }
|
||||
330 {25.0 1.67827e-06 }
|
||||
}
|
||||
|
||||
array set EApLookupTable {
|
||||
0 { 5 circ}
|
||||
30 {10 circ}
|
||||
60 {20 circ}
|
||||
90 {30 circ}
|
||||
120 {40 circ}
|
||||
150 {50 circ}
|
||||
180 {50 squ }
|
||||
210 {open open}
|
||||
240 {open open}
|
||||
270 {open open}
|
||||
300 {open open}
|
||||
330 {open open}
|
||||
}
|
||||
}
|
||||
|
||||
proc ::optics::AttRotLookup {angle column tol} {
|
||||
variable AttRotLookupTable
|
||||
|
||||
set catch_status [ catch {
|
||||
set foundit false
|
||||
foreach vangle [array names AttRotLookupTable] {
|
||||
if {$vangle >= [expr {$angle-$tol}] && $vangle <= [expr {$angle+$tol}]} {
|
||||
set foundit true
|
||||
break
|
||||
}
|
||||
}
|
||||
if {$foundit == true} {
|
||||
switch $column {
|
||||
"plex" { set index 0 }
|
||||
"attfactor" { set index 1 }
|
||||
default { error "$column is unknown, allowed values are plex or attfactor" }
|
||||
}
|
||||
return [lindex $AttRotLookupTable($vangle) $index]
|
||||
} else {
|
||||
return -1
|
||||
}
|
||||
} message ]
|
||||
handle_exception $catch_status $message
|
||||
}
|
||||
|
||||
proc ::optics::EApLookUp {angle param tol} {
|
||||
variable EApLookupTable
|
||||
|
||||
set foundit false
|
||||
if [ catch {
|
||||
if {$param == "size"} {
|
||||
set cgf [SplitReply [GuideConfig]]
|
||||
if {[string first $cgf "g1 g2 g3 g4 g5 g6 g7 g8 g9 p1 p2 p3 p4 p5 p6 p7 p8 p9"] != -1} {
|
||||
return 50
|
||||
}
|
||||
}
|
||||
switch $param {
|
||||
"size" {set index 0}
|
||||
"shape" {set index 1}
|
||||
default {
|
||||
error "ERROR: Invalid lookup parameter $param"
|
||||
}
|
||||
}
|
||||
foreach vangle [array names EApLookupTable] {
|
||||
if {$vangle >= [expr {$angle-$tol}] && $vangle <= [expr {$angle+$tol}]} {
|
||||
set foundit true
|
||||
break
|
||||
}
|
||||
}
|
||||
if {$foundit == true} {
|
||||
return [lindex $EApLookupTable($vangle) $index]
|
||||
} else {
|
||||
switch $param {
|
||||
"size" {return 0}
|
||||
"shape" {return "UNKNOWN"}
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode == "NONE"} {return $message}
|
||||
return -code error "$message"
|
||||
}
|
||||
}
|
||||
@@ -1,66 +0,0 @@
|
||||
##
|
||||
# @file
|
||||
# A guide configuration table where each line describes the setup
|
||||
# for a mode of operation.
|
||||
# The table will have a corresponding interpretation list which provides
|
||||
# commands to setup the instrument.
|
||||
|
||||
namespace eval optics {
|
||||
##
|
||||
# @brief These arrays map the component identifiers (G, MT, etc) to the
|
||||
# position index for each guide motor (c1, c2 ... c9)
|
||||
array set c1_map {G 1 MT 2 P 3}
|
||||
array set c2_map {MT 1 G 2 A 3}
|
||||
array set c3_map {MT 1 G 2 A 3}
|
||||
array set c4_map {MT 1 G 2 A 3}
|
||||
array set c5_map {MT 1 G 2 A 3}
|
||||
array set c6_map {MT 1 G 2 A 3}
|
||||
array set c7_map {MT 1 G 2 A 3}
|
||||
array set c8_map {MT 1 G 2 A 3}
|
||||
array set c9_map {L 1 MT 2 G 3 A 4 LP 5}
|
||||
|
||||
# The guide configuration table is indexed by a configuration
|
||||
# identifier (ga, mt, lp, etc). Each row has two elements,
|
||||
# 1. A list of components selected for each guide (MT A ... etc)
|
||||
# 2. The entrance aperature position in mm
|
||||
# Eg $guide_configuration(p2) returns the following list
|
||||
# {{P G A A A A A A A } 6934}
|
||||
array set guide_configuration {
|
||||
ga {{MT A A A A A A A A } 675}
|
||||
mt {{MT MT MT MT MT MT MT MT MT} 675}
|
||||
lp {{MT MT MT MT MT MT MT MT LP} 675}
|
||||
lens {{MT MT MT MT MT MT MT MT L } 675}
|
||||
p1 {{P A MT MT MT MT MT MT MT} 4621}
|
||||
p1lp {{P A MT MT MT MT MT MT LP} 4621}
|
||||
p1lens {{P A MT MT MT MT MT MT L } 4621}
|
||||
g1 {{G A A A A A A A A } 4929}
|
||||
p2 {{P G A A A A A A A } 6934}
|
||||
g2 {{G G A A A A A A A } 6934}
|
||||
p3 {{P G G A A A A A A } 8949}
|
||||
g3 {{G G G A A A A A A } 8949}
|
||||
p4 {{P G G G A A A A A } 10955}
|
||||
g4 {{G G G G A A A A A } 10955}
|
||||
p5 {{P G G G G A A A A } 12943}
|
||||
g5 {{G G G G G A A A A } 12943}
|
||||
p6 {{P G G G G G A A A } 14970}
|
||||
g6 {{G G G G G G A A A } 14970}
|
||||
p7 {{P G G G G G G A A } 16971}
|
||||
g7 {{G G G G G G G A A } 16971}
|
||||
p8 {{P G G G G G G G A } 18937}
|
||||
g8 {{G G G G G G G G A } 18937}
|
||||
p9 {{P G G G G G G G G } 19925}
|
||||
g9 {{G G G G G G G G G } 19925}
|
||||
}
|
||||
|
||||
# This list maps the motor names to columns of the
|
||||
# guide_configuration table.
|
||||
set guide_configuration_columns {
|
||||
c1 c2 c3 c4 c5 c6 c7 c8 c9
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
namespace eval optics {
|
||||
variable guide_configuration
|
||||
variable guide_configuration_columns
|
||||
}
|
||||
@@ -1,2 +1,2 @@
|
||||
fileeval $cfPath(optics)/guide_configuration.tcl
|
||||
fileeval $cfPath(optics)/aperture_configuration.tcl
|
||||
#fileeval $cfPath(optics)/guide_configuration.tcl
|
||||
#fileeval $cfPath(optics)/aperture_configuration.tcl
|
||||
|
||||
@@ -1,157 +0,0 @@
|
||||
# TODO Make readonly getset macro for AttFactor
|
||||
|
||||
##
|
||||
# @file The velocity selector position is used as the reference for other instrument
|
||||
# component positions. For simplicity we set it as the origin x=y=z=0.
|
||||
|
||||
##
|
||||
# Note EndFacePosY and RotApPosY are surveyed positions
|
||||
foreach {var lname type priv units klass} {
|
||||
BeamCenterX BeamCenterX float user mm reduce
|
||||
BeamCenterZ BeamCenterZ float user mm reduce
|
||||
BeamStop BeamStop int user none parameter
|
||||
BSdiam BSdiam float user mm parameter
|
||||
DetPosYOffset DetPosYOffset float user mm parameter
|
||||
EApPosY EApPosY float user mm parameter
|
||||
EndFacePosY EndFacePosY float readonly mm parameter
|
||||
GuideConfig GuideConfig text user none parameter
|
||||
magnetic_field magnetic_field float user T sample
|
||||
RotApPosY RotApPosY float readonly mm @none
|
||||
SampleThickness SampleThickness float user mm sample
|
||||
SamYOffset SamYOffset float user mm parameter
|
||||
Transmission Transmission float user 1 parameter
|
||||
TransmissionFlag TransmissionFlag int user none sample
|
||||
} {
|
||||
::utility::mkVar $var $type $priv $lname true $klass true true
|
||||
if {$units != "none"} {
|
||||
sicslist setatt $var units $units
|
||||
}
|
||||
}
|
||||
sicslist setatt Transmission link data_set
|
||||
|
||||
proc sicsmsgfmt {args} {return "[info level -1] = $args"}
|
||||
|
||||
::utility::macro::getset float Plex {} {
|
||||
return [sicsmsgfmt [ ::optics::AttRotLookup [SplitReply [att]] "plex" [SplitReply [att precision]] ]]
|
||||
}
|
||||
sicslist setatt Plex units mm
|
||||
sicslist setatt Plex long_name Plex
|
||||
sicslist setatt Plex klass parameter
|
||||
|
||||
::utility::macro::getset float AttFactor {} {
|
||||
return [sicsmsgfmt [ ::optics::AttRotLookup [SplitReply [att]] "attfactor" [SplitReply [att precision]] ]]
|
||||
}
|
||||
sicslist setatt AttFactor long_name AttFactor
|
||||
sicslist setatt AttFactor klass parameter
|
||||
|
||||
::utility::macro::getset float EApX {} {
|
||||
return [sicsmsgfmt [::optics::EApLookUp [SplitReply [srce]] "size" [SplitReply [srce precision]] ]]
|
||||
}
|
||||
sicslist setatt EApX units mm
|
||||
sicslist setatt EApX long_name EApX
|
||||
sicslist setatt EApX klass parameter
|
||||
|
||||
::utility::macro::getset float EApZ {} {
|
||||
return [sicsmsgfmt [::optics::EApLookUp [SplitReply [srce]] "size" [SplitReply [srce precision]] ]]
|
||||
}
|
||||
sicslist setatt EApZ units mm
|
||||
sicslist setatt EApZ long_name EApZ
|
||||
sicslist setatt EApZ klass parameter
|
||||
|
||||
::utility::macro::getset text EApShape {} {
|
||||
return [sicsmsgfmt [::optics::EApLookUp [SplitReply [srce]] "shape" [SplitReply [srce precision]] ]]
|
||||
}
|
||||
sicslist setatt EApShape long_name EApShape
|
||||
sicslist setatt EApShape klass parameter
|
||||
sicslist setatt EApShape mutable false
|
||||
|
||||
::utility::macro::getset float L1 {} {
|
||||
set efpy [SplitReply [EndFacePosY]]
|
||||
set samposy [SplitReply [samy]]
|
||||
set eapy [SplitReply [EApPosY]]
|
||||
return [sicsmsgfmt [expr {$efpy + $samposy - $eapy}]]
|
||||
}
|
||||
sicslist setatt L1 long_name L1
|
||||
sicslist setatt L1 klass parameter
|
||||
sicslist setatt L1 units mm
|
||||
|
||||
::utility::macro::getset float L2 {} {
|
||||
set detpy [SplitReply [det]]
|
||||
set detpyos [SplitReply [DetPosYOffset]]
|
||||
set sapy [SplitReply [samy]]
|
||||
return [sicsmsgfmt [expr {$detpy + $detpyos - $sapy}]]
|
||||
}
|
||||
sicslist setatt L2 long_name L2
|
||||
sicslist setatt L2 klass parameter
|
||||
sicslist setatt L2 units mm
|
||||
|
||||
|
||||
################################################################################
|
||||
# INITIALISE PARAMETERS
|
||||
# The collimation system aperture positions
|
||||
# Reference position is outer wall of velocity selector bunker, ie EndFacePosY
|
||||
array set collapposmm {
|
||||
inputguide 633
|
||||
apwheel 675
|
||||
ap1 4929
|
||||
ap2 6934
|
||||
ap3 8949
|
||||
ap4 10955
|
||||
ap5 12943
|
||||
ap6 14970
|
||||
ap7 16971
|
||||
ap9 19925
|
||||
}
|
||||
|
||||
EndFacePosY 20095
|
||||
RotApPosY 675
|
||||
|
||||
################################################################################
|
||||
# Check Config
|
||||
namespace eval parameters {
|
||||
set paramlist {
|
||||
AttFactor
|
||||
BSdiam
|
||||
DetPosYOffset
|
||||
EApPosY
|
||||
EApShape
|
||||
EApX
|
||||
EApZ
|
||||
EndFacePosY
|
||||
L1
|
||||
L2
|
||||
Plex
|
||||
SamYOffset
|
||||
Transmission
|
||||
}
|
||||
}
|
||||
##
|
||||
# @brief List undefined parameters
|
||||
proc ::parameters::missingparams {} {
|
||||
variable paramlist
|
||||
set num 0
|
||||
foreach param $paramlist {
|
||||
if {[sicslist match $param] == " "} {
|
||||
clientput $param
|
||||
incr num
|
||||
}
|
||||
}
|
||||
if {$num > 0} {
|
||||
clientput "There are $num missing parameters"
|
||||
} else {
|
||||
clientput "OK"
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Check list
|
||||
proc check {args} {
|
||||
switch $args {
|
||||
"missing" {
|
||||
::parameters::missingparams
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
publish check user
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
source $cfPath(source)/source_common.tcl
|
||||
|
||||
proc ::source::isc_initialize {} {
|
||||
::source::ic_initialize "cold"
|
||||
::source::ic_initialize "thermal"
|
||||
}
|
||||
|
||||
|
||||
@@ -1,616 +0,0 @@
|
||||
# TODO Check if requested tilt-angle is within range
|
||||
# TODO What should be reported for the wavelength if the tilt angle is 999.99
|
||||
##
|
||||
# @file
|
||||
# The velocity selector control is split into two objects,
|
||||
# 1. velsel_poller: This object polls the velocity selector to get its
|
||||
# current state. The first time that it gets valid state info it will
|
||||
# register the read and write parameters for the velocity_selector object
|
||||
# and create nvs_speed and nvs_lambda drivable adapters.
|
||||
# 2. velocity_selector: This object manages a set of status nodes which
|
||||
# correspond to the state parameters read by the velsel_poller object.
|
||||
# It also provides commands to set the speed, wavelength and angle for the velocity
|
||||
# selector and provides drivable interfaces for the speed and wavelength.
|
||||
#
|
||||
# You can drive the velocity selector speed via the driveable object called nvs_speed
|
||||
# You can drive the wavelength via the driveable object called nvs_lambda
|
||||
|
||||
# NOTE Doesn't provide the power loss command. Do we need it?
|
||||
|
||||
# Test by adding the following to barebones.tcl
|
||||
# InstallHdb
|
||||
# source config/velocity_selector/xsct_velsel.tcl
|
||||
# hfactory /velocity_selector link velocity_selector
|
||||
|
||||
# The velocity selector doesn't close client connections
|
||||
# if the connection is broken. It only closes the connection
|
||||
# when a client logs off with "#SES#bye", NOTE bye must be lowercase.
|
||||
|
||||
namespace eval ::scobj::velocity_selector {
|
||||
variable UID
|
||||
variable PWD
|
||||
variable sim_mode
|
||||
variable paramindex
|
||||
variable paramtype
|
||||
variable pollrate 7
|
||||
|
||||
#from NVSOptions.cpp nha
|
||||
# m_dTwistAngle degrees
|
||||
# m_dTwistAngle m
|
||||
# m_iMaxSpeed rpm
|
||||
variable m_dTwistAngle
|
||||
variable m_dLength
|
||||
variable m_iMaxSpeed
|
||||
variable rBeamCenter
|
||||
variable VNeutron
|
||||
variable blocked_speeds
|
||||
|
||||
set sim_mode [SplitReply [velsel_simulation]]
|
||||
|
||||
proc AngleSpeedToWavelength {angle VsVarSpeed} {
|
||||
variable m_dTwistAngle
|
||||
variable m_dLength
|
||||
variable m_iMaxSpeed
|
||||
variable rBeamCenter
|
||||
variable VNeutron
|
||||
|
||||
if {$VsVarSpeed < 3100} {
|
||||
return -code error "Minimum speed is 3100 rpm"
|
||||
}
|
||||
|
||||
set lambda0 [expr ($m_dTwistAngle*60.0*$VNeutron)/(360.0*$m_dLength*$m_iMaxSpeed)]
|
||||
set pi [expr acos(-1)]
|
||||
# set pi = 3.14159265358979;
|
||||
|
||||
set A [expr (2.0 * $rBeamCenter * $pi) / (60.0 * $VNeutron)]
|
||||
set angle_rad [expr ($angle * $pi) / 180.0]
|
||||
set lambda1 [expr ( tan($angle_rad)+($A * $m_iMaxSpeed * $lambda0) ) / ((-($A*$A) * $m_iMaxSpeed * $VsVarSpeed * $lambda0 * tan($angle_rad) )+($A * $VsVarSpeed))]
|
||||
|
||||
return [format "%#.5g" $lambda1]
|
||||
}
|
||||
|
||||
proc WavelengthToSpeed {angle lambda1} {
|
||||
variable m_dTwistAngle
|
||||
variable m_dLength
|
||||
variable m_iMaxSpeed
|
||||
variable rBeamCenter
|
||||
variable VNeutron
|
||||
|
||||
if {$lambda1 < 4.6125} {
|
||||
return -code error "Minimum wavelength is 4.6125 Angstrom"
|
||||
}
|
||||
|
||||
set lambda0 [expr ($m_dTwistAngle*60.0*$VNeutron)/(360.0*$m_dLength*$m_iMaxSpeed)]
|
||||
set pi [expr acos(-1)]
|
||||
# set pi = 3.14159265358979;
|
||||
|
||||
set A [expr (2.0 * $rBeamCenter * $pi) / (60.0 * $VNeutron)]
|
||||
set angle_rad [expr ($angle * $pi) / 180.0]
|
||||
set VsVarSpeed [expr ( tan($angle_rad)+($A * $m_iMaxSpeed * $lambda0) ) / ((-($A*$A) * $m_iMaxSpeed * $lambda1 * $lambda0 * tan($angle_rad) )+($A * $lambda1))]
|
||||
|
||||
return [expr round($VsVarSpeed)]
|
||||
}
|
||||
|
||||
|
||||
foreach {
|
||||
param index type units } {
|
||||
state 0 text @none
|
||||
rspeed 1 float rpm
|
||||
aspeed 2 float rpm
|
||||
sspeed 3 float Hz
|
||||
aveto 4 text @none
|
||||
ploss 5 float @none
|
||||
splos 6 float @none
|
||||
ttang 7 float degrees
|
||||
rtemp 8 float degrees
|
||||
wflow 9 float @none
|
||||
winlt 10 float @none
|
||||
woutt 11 float @none
|
||||
vacum 12 float @none
|
||||
wvalv 13 text @none
|
||||
vvalv 14 text @none
|
||||
vibrt 15 float @none
|
||||
bcuun 16 float @none
|
||||
} {
|
||||
set paramindex($param) $index
|
||||
set paramtype($param) $type
|
||||
set paramunits($param) $units
|
||||
}
|
||||
|
||||
MakeSICSObj velsel_poller SCT_OBJECT
|
||||
MakeSICSObj velocity_selector SCT_OBJECT
|
||||
sicslist setatt velocity_selector klass NXvelocity_selector
|
||||
sicslist setatt velocity_selector long_name velocity_selector
|
||||
|
||||
proc sendUID {user} {
|
||||
sct send $user
|
||||
return rdPwdChallenge
|
||||
}
|
||||
|
||||
proc rdPwdChallenge {} {
|
||||
set challenge [sct result]
|
||||
return sndPwd
|
||||
}
|
||||
proc sndPwd {pwd} {
|
||||
sct send $pwd
|
||||
return rdPwdAck
|
||||
}
|
||||
proc rdPwdAck {} {
|
||||
set ack [sct result]
|
||||
return idle
|
||||
}
|
||||
##
|
||||
# @brief Request a state report from the velocity selector
|
||||
proc getStatus {} {
|
||||
sct send "N#SOS#STATE "
|
||||
return rdState
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Read the current state report from the velocity selector.
|
||||
proc rdState {root statuspath} {
|
||||
variable paramindex
|
||||
|
||||
set staterep [sct result]
|
||||
if {[string match {ASCERR:*} $staterep]} {
|
||||
hset $root/device_error $staterep
|
||||
return idle
|
||||
}
|
||||
if {[string match {*#SES#You are not a valid user*} $staterep]} {
|
||||
return sendUID
|
||||
}
|
||||
if {[string match {N#SOS#*} $staterep] == 0 } {
|
||||
hset $root/device_error $staterep
|
||||
return idle
|
||||
}
|
||||
set status [lrange [split $staterep "#"] 3 end-1]
|
||||
set rspeed [lindex $status $paramindex(rspeed) end]
|
||||
set aspeed [lindex $status $paramindex(aspeed) end]
|
||||
set speedvar [expr 0.2*$rspeed/100]
|
||||
if {[hval $root/status] == "busy"} {
|
||||
set target [hgetpropval $root/setspeed target]
|
||||
if {$rspeed != $target} {
|
||||
hset $root/device_error "Resending target speed $target"
|
||||
hset $root/setspeed $target"
|
||||
return idle
|
||||
}
|
||||
if {[expr abs($rspeed - $aspeed)] <= $speedvar} {
|
||||
hset $root/status "idle"
|
||||
statemon stop nvs_speed
|
||||
statemon stop nvs_lambda
|
||||
if [hgetpropval $root/setspeed driving] {
|
||||
hsetprop $root/setspeed driving 0
|
||||
hsetprop $root/setLambda driving 0
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$staterep != [sct oldval]} {
|
||||
set state [lindex $status $paramindex(state) end]
|
||||
if {$state != [sct oldstate]} {
|
||||
if {[string match {*CONTROL*} $state] && [expr abs($rspeed - $aspeed)] > $speedvar} {
|
||||
# hset $root/status "busy"
|
||||
} elseif {[string match {*CONTROL*} $state]==0 && $aspeed == 0} {
|
||||
hset $root/status "idle"
|
||||
statemon stop nvs_speed
|
||||
statemon stop nvs_lambda
|
||||
if [hgetpropval $root/setspeed driving] {
|
||||
hsetprop $root/setspeed driving 0
|
||||
hsetprop $root/setLambda driving 0
|
||||
}
|
||||
}
|
||||
sct oldstate $state
|
||||
}
|
||||
if {[sct oldval] == "UNKNOWN"} {
|
||||
sct_velsel_init $root
|
||||
}
|
||||
sct oldval $staterep
|
||||
sct update $status
|
||||
sct utime readtime
|
||||
}
|
||||
if {[hval $root/device_error] != ""} {
|
||||
hset $root/device_error ""
|
||||
}
|
||||
return idle
|
||||
}
|
||||
|
||||
##
|
||||
# @brief This dummy read command forces a transition to a state which
|
||||
# will update a parameter from the current status.
|
||||
proc getpar {nextstate} {
|
||||
return $nextstate
|
||||
}
|
||||
|
||||
proc noResponse {} {
|
||||
sct result
|
||||
return idle
|
||||
}
|
||||
##
|
||||
# @brief Looks up a parameter in the current status and updates the
|
||||
# parameter node.
|
||||
# @param statuspath, path to the poller object's status node.
|
||||
# @param parindex, index of the required parameter
|
||||
proc updatepar {statuspath parindex} {
|
||||
set data [lindex [hval $statuspath] $parindex end]
|
||||
if {$data != [sct oldval]} {
|
||||
sct oldval $data
|
||||
sct update $data
|
||||
sct utime readtime
|
||||
}
|
||||
return idle
|
||||
}
|
||||
|
||||
proc setSpeed {vs_root statuspath nextState} {
|
||||
variable paramindex
|
||||
set speed [format "%5d" [sct target]]
|
||||
|
||||
sct send "N#SOS#SPEED $speed"
|
||||
set angle [lindex [hval $statuspath] $paramindex(ttang) end]
|
||||
set lambda [AngleSpeedToWavelength $angle $speed]
|
||||
sct target $speed
|
||||
hsetprop $vs_root/setLambda target $lambda
|
||||
hset $vs_root/status "busy"
|
||||
statemon start nvs_speed
|
||||
statemon start nvs_lambda
|
||||
if {[sct writestatus] == "start"} {
|
||||
# Called by drive adapter
|
||||
hsetprop $vs_root/setspeed driving 1
|
||||
hsetprop $vs_root/setLambda driving 1
|
||||
}
|
||||
return $nextState
|
||||
}
|
||||
|
||||
proc sendCommand {nextState} {
|
||||
set state [string tolower [sct target]]
|
||||
switch $state {
|
||||
"idle" {
|
||||
sct send "N#SOS#IDLE "
|
||||
}
|
||||
"brake" {
|
||||
sct send "N#SOS#BRAKE "
|
||||
}
|
||||
"init" {
|
||||
sct send "N#SOS#TTINIT"
|
||||
}
|
||||
default {
|
||||
return idle
|
||||
}
|
||||
}
|
||||
return $nextState
|
||||
}
|
||||
|
||||
|
||||
proc readLambda {statuspath} {
|
||||
variable paramindex
|
||||
|
||||
set angle [lindex [hval $statuspath] $paramindex(ttang) end]
|
||||
set aspeed [lindex [hval $statuspath] $paramindex(aspeed) end]
|
||||
if {$aspeed >= 800} {
|
||||
set lambda [AngleSpeedToWavelength $angle $aspeed]
|
||||
} else {
|
||||
set lambda 9999
|
||||
}
|
||||
if {$lambda != [sct oldval]} {
|
||||
sct oldval $lambda
|
||||
sct update $lambda
|
||||
sct utime readtime
|
||||
}
|
||||
return idle
|
||||
}
|
||||
|
||||
##
|
||||
# @brief This will check if turntable operation is allowed
|
||||
proc ttableCheck {statuspath nextState} {
|
||||
variable paramindex
|
||||
|
||||
set state [lindex [hval $statuspath] $paramindex(state) end]
|
||||
set aspeed [lindex [hval $statuspath] $paramindex(aspeed) end]
|
||||
if {[string match {*CONTROL*} $state] || $aspeed != 0} {
|
||||
error "Not allowed while the velocity selector is running"
|
||||
}
|
||||
return OK
|
||||
}
|
||||
|
||||
proc is_Speed_in_blocked_range {speed} {
|
||||
variable blocked_speeds
|
||||
foreach {min max} $blocked_speeds {
|
||||
if {$min <= $speed && $speed <= $max} {
|
||||
error "Speed of $speed rpm is within the blocked range of $min to $max rpm"
|
||||
}
|
||||
}
|
||||
return OK
|
||||
}
|
||||
proc get_nearest_allowed_speed {speed} {
|
||||
variable blocked_speeds
|
||||
set speed_ok true
|
||||
|
||||
foreach {min max} $blocked_speeds {
|
||||
if {$min <= $speed && $speed <= $max} {
|
||||
set speed_ok false
|
||||
break
|
||||
}
|
||||
}
|
||||
if {$speed_ok} {
|
||||
return $speed
|
||||
} else {
|
||||
foreach {min max} $blocked_speeds {
|
||||
if {$min <= $speed && $speed <= $max} {
|
||||
if {$min == -inf} {
|
||||
return [expr $max+10]
|
||||
}
|
||||
if {$max == inf} {
|
||||
return [expr $min-10]
|
||||
}
|
||||
if {[expr $max - $speed] > [expr $speed - $min]} {
|
||||
return [expr $min-10]
|
||||
} else {
|
||||
return [expr $max+10]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief This will check if the requested speed is allowed
|
||||
proc checkBlockedSpeeds {statuspath} {
|
||||
variable paramindex
|
||||
|
||||
set speed [sct target]
|
||||
set ttang [lindex [hval $statuspath] $paramindex(ttang) end]
|
||||
if {$ttang > 90} {
|
||||
error "ERROR: You must first initialise the turntable"
|
||||
}
|
||||
|
||||
return [is_Speed_in_blocked_range $speed]
|
||||
}
|
||||
|
||||
##
|
||||
# @brief This will check if target wavelength is allowed
|
||||
proc checkBlockedWavelengths {statuspath} {
|
||||
variable paramindex
|
||||
|
||||
set lambda [sct target]
|
||||
set ttang [lindex [hval $statuspath] $paramindex(ttang) end]
|
||||
if {$ttang > 90} {
|
||||
error "ERROR: You must first initialise the turntable"
|
||||
}
|
||||
set angle [lindex [hval $statuspath] $paramindex(ttang) end]
|
||||
set speed [WavelengthToSpeed $angle $lambda]
|
||||
return [is_Speed_in_blocked_range $speed]
|
||||
}
|
||||
##
|
||||
# @brief Implement the checkstatus command for the drivable interface
|
||||
#
|
||||
# NOTE: The drive adapter initially sets the writestatus to "start" and will
|
||||
# only call this when writestatus!="start"
|
||||
# TODO Do we need to handle hardware faults or is the state check in rdstate enough?
|
||||
proc drivestatus {} {
|
||||
if [sct driving] {
|
||||
return busy
|
||||
} else {
|
||||
return idle
|
||||
}
|
||||
}
|
||||
|
||||
proc halt {root} {
|
||||
hsetprop $root/setspeed driving 0
|
||||
hsetprop $root/setLambda driving 0
|
||||
hset $root/status "idle"
|
||||
statemon stop nvs_speed
|
||||
statemon stop nvs_lambda
|
||||
set speed [get_nearest_allowed_speed [hval $root/aspeed]]
|
||||
broadcast halt: set speed to $speed
|
||||
catch {hset $root/setspeed $speed} msg
|
||||
broadcast $msg
|
||||
return idle
|
||||
}
|
||||
|
||||
proc setPar {par nextState} {
|
||||
set val [sct target]
|
||||
sct send "N#SOS#$par $val"
|
||||
return $nextState
|
||||
}
|
||||
|
||||
proc setLambda {vs_root statuspath nextState} {
|
||||
variable paramindex
|
||||
set lambda [sct target]
|
||||
|
||||
set angle [lindex [hval $statuspath] $paramindex(ttang) end]
|
||||
set speed [WavelengthToSpeed $angle $lambda]
|
||||
set fmtspeed [format "%5d" $speed]
|
||||
sct send "N#SOS#SPEED $fmtspeed"
|
||||
sct target $lambda
|
||||
hsetprop $vs_root/setspeed target $speed
|
||||
hset $vs_root/status "busy"
|
||||
statemon start nvs_speed
|
||||
statemon start nvs_lambda
|
||||
if {[sct writestatus] == "start"} {
|
||||
# Called by drive adapter
|
||||
hsetprop $vs_root/setLambda driving 1
|
||||
hsetprop $vs_root/setspeed driving 1
|
||||
}
|
||||
return $nextState
|
||||
}
|
||||
|
||||
# Create Velocity selector control
|
||||
set scobjNS ::scobj::velocity_selector
|
||||
set statusPath /sics/velsel_poller/status
|
||||
set velselPath /sics/velocity_selector
|
||||
|
||||
hfactory $statusPath plain internal text
|
||||
hsetprop $statusPath read ${scobjNS}::getStatus
|
||||
hsetprop $statusPath rdState ${scobjNS}::rdState $velselPath $statusPath
|
||||
hsetprop $statusPath sendUID ${scobjNS}::sendUID $UID
|
||||
hsetprop $statusPath rdPwdChallenge ${scobjNS}::rdPwdChallenge
|
||||
hsetprop $statusPath sndPwd ${scobjNS}::sndPwd $PWD
|
||||
hsetprop $statusPath rdPwdAck ${scobjNS}::rdPwdAck
|
||||
hsetprop $statusPath oldval "UNKNOWN"
|
||||
hsetprop $statusPath oldstate "UNKNOWN"
|
||||
|
||||
# Set identifier
|
||||
hfactory $velselPath/ID plain spy text
|
||||
hset $velselPath/ID $velsel_ID
|
||||
|
||||
# Abstract status info for GumTree
|
||||
hfactory $velselPath/status plain spy text
|
||||
hset $velselPath/status "UNKNOWN"
|
||||
hsetprop $velselPath/status values busy,idle
|
||||
hfactory $velselPath/device_error plain spy text
|
||||
hset $velselPath/device_error ""
|
||||
|
||||
# Must be set by user
|
||||
hfactory $velselPath/LambdaResFWHM_percent plain user float
|
||||
hfactory $velselPath/geometry plain spy none
|
||||
hfactory $velselPath/geometry/position plain spy none
|
||||
hfactory $velselPath/geometry/position/VelSelPosX plain user float
|
||||
hsetprop $velselPath/geometry/position/VelSelPosX units "mm"
|
||||
hfactory $velselPath/geometry/position/VelSelPosY plain user float
|
||||
hsetprop $velselPath/geometry/position/VelSelPosY units "mm"
|
||||
hfactory $velselPath/geometry/position/VelSelPosZ plain user float
|
||||
hsetprop $velselPath/geometry/position/VelSelPosZ units "mm"
|
||||
hfactory $velselPath/geometry/position/VelSelCoordScheme plain user text
|
||||
|
||||
# Setup nodes for state report parameters
|
||||
foreach par [lsort [array names paramindex]] {
|
||||
hfactory $velselPath/$par plain spy $paramtype($par)
|
||||
hsetprop $velselPath/$par read ${scobjNS}::getpar rdpar
|
||||
hsetprop $velselPath/$par rdpar ${scobjNS}::updatepar $statusPath $paramindex($par)
|
||||
hsetprop $velselPath/$par oldval "UNKNOWN"
|
||||
if {$paramunits($par) != "@none"} {
|
||||
hsetprop $velselPath/$par units $paramunits($par)
|
||||
}
|
||||
}
|
||||
# Initialise turntable command
|
||||
hfactory $velselPath/ttinit plain spy none
|
||||
hsetprop $velselPath/ttinit check ${scobjNS}::ttableCheck $statusPath ignore
|
||||
hsetprop $velselPath/ttinit write ${scobjNS}::sendCommand ignore
|
||||
hsetprop $velselPath/ttinit ignore ${scobjNS}::noResponse
|
||||
hsetprop $velselPath/ttinit values init
|
||||
|
||||
# Set tilt angle
|
||||
# TODO Can we set "check" to test if angle is within range then chain to ttableCheck
|
||||
hfactory $velselPath/set_ttang plain spy float
|
||||
hsetprop $velselPath/set_ttang check ${scobjNS}::ttableCheck $statusPath ignore
|
||||
hsetprop $velselPath/set_ttang write ${scobjNS}::setPar TTANGL ignore
|
||||
hsetprop $velselPath/set_ttang ignore ${scobjNS}::noResponse
|
||||
hsetprop $velselPath/set_ttang units "degrees"
|
||||
|
||||
|
||||
# Get Lambda
|
||||
hfactory $velselPath/Lambda plain spy float
|
||||
hsetprop $velselPath/Lambda read ${scobjNS}::getpar rdpar
|
||||
hsetprop $velselPath/Lambda rdpar ${scobjNS}::readLambda $statusPath
|
||||
hsetprop $velselPath/Lambda oldval "UNKNOWN"
|
||||
hsetprop $velselPath/Lambda units "Angstrom"
|
||||
hsetprop $velselPath/Lambda permlink data_set
|
||||
|
||||
# Set Lambda
|
||||
hfactory $velselPath/setLambda plain spy float
|
||||
hsetprop $velselPath/setLambda check ${scobjNS}::checkBlockedWavelengths $statusPath
|
||||
hsetprop $velselPath/setLambda write ${scobjNS}::setLambda $velselPath $statusPath ignore
|
||||
hsetprop $velselPath/setLambda ignore ${scobjNS}::noResponse
|
||||
hsetprop $velselPath/setLambda driving 0
|
||||
#TODO WARNING remove sicsdev and type if setLambda gets a drive addapter
|
||||
# hsetprop $velselPath/setLambda sicsdev "nvs_lambda"
|
||||
hsetprop $velselPath/setLambda type "drivable"
|
||||
hsetprop $velselPath/setLambda target 0
|
||||
hsetprop $velselPath/setLambda writestatus "UNKNOWN"
|
||||
hsetprop $velselPath/setLambda units "Angstrom"
|
||||
|
||||
# Set speed
|
||||
hfactory $velselPath/setspeed plain spy int
|
||||
hsetprop $velselPath/setspeed check ${scobjNS}::checkBlockedSpeeds $statusPath
|
||||
hsetprop $velselPath/setspeed write ${scobjNS}::setSpeed $velselPath $statusPath ignore
|
||||
hsetprop $velselPath/setspeed ignore ${scobjNS}::noResponse
|
||||
hsetprop $velselPath/setspeed driving 0
|
||||
hsetprop $velselPath/setspeed type "drivable"
|
||||
hsetprop $velselPath/setspeed target 0
|
||||
hsetprop $velselPath/setspeed writestatus "UNKNOWN"
|
||||
hsetprop $velselPath/setspeed units "rpm"
|
||||
|
||||
# Stop velocity selector (brake or idle)
|
||||
hfactory $velselPath/cmd plain spy text
|
||||
hsetprop $velselPath/cmd write ${scobjNS}::sendCommand ignore
|
||||
hsetprop $velselPath/cmd ignore ${scobjNS}::noResponse
|
||||
hsetprop $velselPath/cmd values brake,idle
|
||||
|
||||
#XXX ::scobj::hinitprops velocity_selector
|
||||
::scobj::set_required_props $velselPath
|
||||
hsetprop $velselPath klass NXvelocity_selector
|
||||
hsetprop $velselPath privilege spy
|
||||
hsetprop $velselPath type part
|
||||
hsetprop $velselPath control true
|
||||
hsetprop $velselPath data true
|
||||
hsetprop $velselPath/geometry klass NXgeometry
|
||||
hsetprop $velselPath/geometry privilege spy
|
||||
hsetprop $velselPath/geometry type instrument
|
||||
hsetprop $velselPath/geometry data true
|
||||
hsetprop $velselPath/geometry control true
|
||||
hsetprop $velselPath/geometry/position klass NXtranslation
|
||||
hsetprop $velselPath/geometry/position privilege spy
|
||||
hsetprop $velselPath/geometry/position type instrument
|
||||
hsetprop $velselPath/geometry/position data true
|
||||
hsetprop $velselPath/geometry/position control true
|
||||
foreach {
|
||||
hpath klass control data nxsave mutable priv alias
|
||||
} {
|
||||
Lambda parameter true true true true user velsel_lambdaa
|
||||
LambdaResFWHM_percent parameter true true true true spy velsel_lambdaresfwhm_percent
|
||||
rspeed parameter true true true true spy velsel_rspeed
|
||||
aspeed parameter true true true true user velsel_aspeed
|
||||
ttang parameter true true true true user velsel_ttang
|
||||
ttinit parameter true false false true user velsel_ttang
|
||||
geometry/position/VelSelPosX parameter true true true false user VelSelPosX
|
||||
geometry/position/VelSelPosY parameter true true true false user VelSelPosY
|
||||
geometry/position/VelSelPosZ parameter true true true false user VelSelPosZ
|
||||
geometry/position/VelSelCoordScheme parameter true true true false user VelSelCoordScheme
|
||||
} {
|
||||
hsetprop $velselPath/$hpath nxalias $alias
|
||||
hsetprop $velselPath/$hpath klass $klass
|
||||
hsetprop $velselPath/$hpath privilege $priv
|
||||
hsetprop $velselPath/$hpath control $control
|
||||
hsetprop $velselPath/$hpath data $data
|
||||
hsetprop $velselPath/$hpath nxsave $nxsave
|
||||
hsetprop $velselPath/$hpath mutable $mutable
|
||||
hsetprop $velselPath/$hpath sdsinfo ::nexus::scobj::sdsinfo
|
||||
}
|
||||
|
||||
hsetprop $velselPath/setspeed checklimits ${scobjNS}::checkBlockedSpeeds $statusPath
|
||||
hsetprop $velselPath/setspeed checkstatus ${scobjNS}::drivestatus
|
||||
hsetprop $velselPath/setspeed halt ${scobjNS}::halt $velselPath
|
||||
|
||||
hsetprop $velselPath/setLambda checklimits ${scobjNS}::checkBlockedWavelengths $statusPath
|
||||
hsetprop $velselPath/setLambda checkstatus ${scobjNS}::drivestatus
|
||||
hsetprop $velselPath/setLambda halt ${scobjNS}::halt $velselPath
|
||||
|
||||
##
|
||||
# @brief This is the position of the velocity selector bunker face. It is used
|
||||
# as the reference for other positions. x=y=z=0.
|
||||
hset $velselPath/geometry/position/VelSelPosX 0.0
|
||||
hset $velselPath/geometry/position/VelSelPosY 0.0
|
||||
hset $velselPath/geometry/position/VelSelPosZ 0.0
|
||||
hset $velselPath/geometry/position/VelSelCoordScheme "Cartesian"
|
||||
|
||||
|
||||
|
||||
proc sct_velsel_init {velselPath } {
|
||||
variable pollrate
|
||||
variable paramindex
|
||||
|
||||
foreach par [lsort [array names paramindex]] {
|
||||
sct_velsel poll $velselPath/$par $pollrate
|
||||
}
|
||||
sct_velsel write $velselPath/ttinit
|
||||
sct_velsel write $velselPath/set_ttang
|
||||
sct_velsel poll $velselPath/Lambda $pollrate
|
||||
sct_velsel write $velselPath/setLambda
|
||||
sct_velsel write $velselPath/setspeed
|
||||
sct_velsel write $velselPath/cmd
|
||||
ansto_makesctdrive nvs_speed $velselPath/setspeed $velselPath/aspeed sct_velsel
|
||||
ansto_makesctdrive nvs_lambda $velselPath/setLambda $velselPath/Lambda sct_velsel
|
||||
}
|
||||
if {$sim_mode == "false"} {
|
||||
makesctcontroller sct_velsel astvelsel $velsel_IP:$velsel_port "" 10
|
||||
sct_velsel poll $statusPath $pollrate
|
||||
}
|
||||
}
|
||||
@@ -1,52 +0,0 @@
|
||||
# Set currVelSel to select either the NVS40 or NVS43
|
||||
set currVelSel 43
|
||||
|
||||
namespace eval ::scobj::velocity_selector {
|
||||
variable blocked_speeds
|
||||
variable velsel_IP
|
||||
variable velsel_port
|
||||
|
||||
# Set configuration parameters for either the NVS40 or NVS43 velocity selector
|
||||
set ::currVelSel [string tolower $::currVelSel]
|
||||
switch $::currVelSel {
|
||||
40 {
|
||||
set velsel_ID "NVS40"
|
||||
set velsel_IP "137.157.202.73"
|
||||
set velsel_port 10000
|
||||
set m_dTwistAngle 48.30
|
||||
set m_dLength 0.250
|
||||
set m_iMaxSpeed 28300.0
|
||||
set rBeamCenter 0.1100
|
||||
set VNeutron 3955.98
|
||||
set ::scobj::velocity_selector::UID "NVS"
|
||||
set ::scobj::velocity_selector::PWD "NVS"
|
||||
set ::scobj::velocity_selector::blocked_speeds {
|
||||
-inf 3099
|
||||
3600 4999
|
||||
7800 10599
|
||||
28301 inf
|
||||
}
|
||||
}
|
||||
43 {
|
||||
# dc2-lyrebird.nbi.ansto.gov.au
|
||||
set velsel_ID "NVS43"
|
||||
set velsel_IP "137.157.202.74"
|
||||
set velsel_port 10000
|
||||
set m_dTwistAngle 37.6
|
||||
set m_dLength 0.250
|
||||
set m_iMaxSpeed 21000.0
|
||||
set rBeamCenter 0.1100
|
||||
set VNeutron 3955.98
|
||||
set ::scobj::velocity_selector::UID "NVS"
|
||||
set ::scobj::velocity_selector::PWD "NVS"
|
||||
set ::scobj::velocity_selector::blocked_speeds {
|
||||
-inf 3099
|
||||
3600 4999
|
||||
7800 9699
|
||||
21500 inf
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#source $cfPath(velsel)/sct_velsel.tcl
|
||||
@@ -24,13 +24,13 @@ fileeval $cfPath(motors)/positmotor_configuration.tcl
|
||||
#fileeval $cfPath(velsel)/velsel.tcl
|
||||
#fileeval $cfPath(parameters)/parameters.tcl
|
||||
fileeval $cfPath(plc)/plc.tcl
|
||||
#fileeval $cfPath(optics)/optics.tcl
|
||||
fileeval $cfPath(optics)/optics.tcl
|
||||
fileeval $cfPath(counter)/counter.tcl
|
||||
#fileeval $cfPath(environment)/temperature/sct_lakeshore_340.tcl
|
||||
#fileeval $cfPath(environment)/temperature/sct_lakeshore_336.tcl
|
||||
fileeval $cfPath(hmm)/hmm_configuration.tcl
|
||||
fileeval $cfPath(nexus)/nxscripts.tcl
|
||||
fileeval $cfPath(hmm)/detector.tcl
|
||||
#fileeval $cfPath(hmm)/detector.tcl
|
||||
fileeval $cfPath(scan)/scan.tcl
|
||||
fileeval $cfPath(commands)/commands.tcl
|
||||
fileeval $cfPath(anticollider)/anticollider.tcl
|
||||
@@ -40,7 +40,6 @@ fileeval $cfPath(anticollider)/anticollider.tcl
|
||||
#fileeval $cfPath(environment)/environment.tcl
|
||||
#fileeval $cfPath(environment)/sct_mcr500_rheometer.tcl
|
||||
#fileeval $cfPath(environment)/sct_protek_common.tcl
|
||||
#fileeval $cfPath(beamline)/spin_flipper.tcl
|
||||
source gumxml.tcl
|
||||
|
||||
::utility::mkVar ::anticollider::protect_detector text manager protect_detector false detector true false
|
||||
|
||||
Reference in New Issue
Block a user