746f495d69
Now using a nexus dictionary variable to set the entry name in data files to prevent duplicate or wrong entry names. Make sure that the isNewFile flag is reset on the first "save" call to prevent file number being incremented multiple times SICS-394 sans commands.tcl Added "selbs", "selbsn", and "selbsxz" commands to select and position a beamstop in a safe manner. SICS-394 sans motor_configuration.tcl Added new beamstop motor drivers. SICS-394 sans parameters.tcl Added BeamStop parameter to record which beamstop has been selected. r2832 | ffr | 2009-12-03 13:04:57 +1100 (Thu, 03 Dec 2009) | 13 lines
382 lines
12 KiB
Tcl
382 lines
12 KiB
Tcl
##
|
|
# @brief We can't change the coordinate scheme at runtime because this would require
|
|
# restructuring the hdb tree, but we should save it.
|
|
foreach {var lname nxname} {
|
|
SApCoordScheme SApCoordScheme coordinate_scheme
|
|
EApCoordScheme EApCoordScheme coordinate_scheme
|
|
SampleCoordScheme SampleCoordScheme coordinate_scheme
|
|
DetCoordScheme DetCoordScheme coordinate_scheme
|
|
BeamstopCoordScheme BeamstopCoordScheme coordinate_scheme
|
|
CollCoordScheme CollCoordScheme coordinate_scheme
|
|
} {
|
|
::utility::mkVar $var text readonly $lname true @none false true
|
|
$var Cartesian
|
|
$var lock
|
|
}
|
|
|
|
##
|
|
# @brief User privilege text variables
|
|
#
|
|
foreach {var lname type priv units klass} {
|
|
SApShape SApShape text user none parameter
|
|
BSShape BSShape text user none parameter
|
|
BeamStop BeamStop int user none parameter
|
|
SampleThickness thickness float user mm sample
|
|
TransmissionFlag transmission_flag int user none sample
|
|
magnetic_field magnetic_field float user T sample
|
|
lambda lambda float user Ao data
|
|
} {
|
|
::utility::mkVar $var $type $priv $lname true $klass true true
|
|
if {$units != "none"} {
|
|
sicslist setatt $var units $units
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief 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.
|
|
foreach {var lname nxname units klass} {
|
|
EndFacePosYmm EndFacePosYmm y mm parameter
|
|
RotApPosYmm RotApPosYmm y mm @none
|
|
} {
|
|
::utility::mkVar $var float readonly $lname true $klass true true
|
|
if {$units != 1} {
|
|
sicslist setatt $var units $units
|
|
}
|
|
}
|
|
|
|
# ::utility::mkVar SampleNum int readonly changer_position true parameter true true
|
|
|
|
##
|
|
# @brief Parameter SicsVariables
|
|
foreach {var lname nxname units priv } {
|
|
LambdaA LambdaA wavelength Ao user
|
|
LambdaResFWHM_percent LambdaResFWHM_percent wavelength_spread 1 user
|
|
VSdeg VSdeg twist degrees user
|
|
VSrpm VSrpm rotation_speed rpm user
|
|
EApYmm EApYmm y mm user
|
|
EApPosYmm EApPosYmm y mm user
|
|
SApXmm SApXmm x mm user
|
|
SApZmm SApZmm z mm user
|
|
SApPosXmm SApPosXmm x mm user
|
|
SApPosYmm SApPosYmm y mm user
|
|
SApPosZmm SApPosZmm z mm user
|
|
SamplePosXmm SamplePosXmm x mm user
|
|
SamYOffsetmm SamYOffsetmm y mm user
|
|
SamplePosZmm SamplePosZmm z mm user
|
|
DetPosYOffsetmm DetPosYOffsetmm detposyoffset mm user
|
|
BSXmm BSXmm x mm user
|
|
BSZmm BSZmm z mm user
|
|
Transmission Transmission Transmission 1 user
|
|
BeamCenterX BeamCenterX BeamCenterX mm user
|
|
BeamCenterZ BeamCenterZ BeamCenterZ mm user
|
|
} {
|
|
::utility::mkVar $var float $priv $lname true parameter true true
|
|
if {$units != 1} {
|
|
sicslist setatt $var units $units
|
|
}
|
|
}
|
|
|
|
# Derived Parameter SicsVariables
|
|
foreach {var type lname units depends} {
|
|
AttFactor float AttFactor 1 AttRotDeg,LambdaA,LambdaResFWHM_percent
|
|
PleXmm float PleXmm mm AttRotDeg
|
|
EApXmm float EApXmm mm RotApDeg
|
|
EApZmm float EApZmm mm RotApDeg
|
|
RotApXmm float RotApXmm mm RotApDeg
|
|
RotApZmm float RotApZmm mm RotApDeg
|
|
EApShape text EApShape 1 RotApDeg
|
|
RotApShape text RotApShape 1 RotApDeg
|
|
} {
|
|
::utility::mkVar $var $type user $lname true derived_parameter true true
|
|
sicslist setatt $var depends $depends
|
|
if {$units != 1} {
|
|
sicslist setatt $var units $units
|
|
}
|
|
}
|
|
proc sicsmsgfmt {args} {return "[info level -1] = $args"}
|
|
::utility::macro::getset float SamplePosYmm {} {
|
|
set sy [SplitReply [samy]]
|
|
set syo [SplitReply [SamYOffsetmm]]
|
|
return [sicsmsgfmt [expr {$sy+$syo}]]
|
|
}
|
|
sicslist setatt SamplePosYmm long_name SamplePosYmm
|
|
sicslist setatt SamplePosYmm klass derived_parameter
|
|
sicslist setatt SamplePosYmm units mm
|
|
sicslist setatt SamplePosYmm depends samy,SamYOffsetmm
|
|
|
|
::utility::macro::getset float L1mm {} {
|
|
set efpy [SplitReply [EndFacePosYmm]]
|
|
set samposy [SplitReply [SamplePosYmm]]
|
|
set eapy [SplitReply [EApPosYmm]]
|
|
return [sicsmsgfmt [expr {$efpy + $samposy - $eapy}]]
|
|
}
|
|
sicslist setatt L1mm long_name L1mm
|
|
sicslist setatt L1mm klass derived_parameter
|
|
sicslist setatt L1mm units mm
|
|
sicslist setatt L1mm depends EndFacePosYmm,SApPosYmm,EApPosYmm
|
|
|
|
::utility::macro::getset float L2mm {} {
|
|
set detpy [SplitReply [DetPosYmm]]
|
|
set detpyos [SplitReply [DetPosYOffsetmm]]
|
|
set sapy [SplitReply [SamplePosYmm]]
|
|
return [sicsmsgfmt [expr {$detpy + $detpyos - $sapy}]]
|
|
}
|
|
sicslist setatt L2mm long_name L2mm
|
|
sicslist setatt L2mm klass derived_parameter
|
|
sicslist setatt L2mm units mm
|
|
sicslist setatt L2mm depends DetPosYmm,DetPosYOffsetmm,SamplePosYmm
|
|
|
|
# Derive motor parameters
|
|
foreach {pname motor units} {
|
|
DetPosXmm detoff mm
|
|
DetPosYmm det mm
|
|
BSPosXmm bsx mm
|
|
BSPosZmm bsz mm
|
|
SampleTiltXDeg samphi degrees
|
|
SampleTiltYDeg samchi degrees
|
|
SampleRotDeg samthet degrees
|
|
} {
|
|
::utility::macro::getset float $pname {} [subst -nocommands {
|
|
return [sicsmsgfmt [SplitReply [$motor]]]
|
|
}]
|
|
sicslist setatt $pname units $units
|
|
sicslist setatt $pname long_name $pname
|
|
sicslist setatt $pname klass derived_parameter
|
|
# sicslist setatt $pname depends $motor
|
|
}
|
|
|
|
foreach {pname motor units} {
|
|
AttRotDeg att degrees
|
|
} {
|
|
::utility::macro::getset float $pname {args} [subst -nocommands {
|
|
# TODO AttFactor
|
|
if {[set args] == ""} {
|
|
return [sicsmsgfmt [SplitReply [$motor]]]
|
|
} else {
|
|
set target [lindex [set args] 0]
|
|
Plexmm -1
|
|
${pname}_status "BUSY"
|
|
drive $motor \$target
|
|
set motpos [SplitReply [$motor]]
|
|
set tolerance [SplitReply [$motor precision] ]
|
|
if {[expr abs(\$motpos - \$target)] > \$tolerance} {
|
|
${pname}_status "IDLE"
|
|
error "ERROR: failed to set $pname target \$target"
|
|
} else {
|
|
Plexmm [::optics::AttRotLookup \$target]
|
|
}
|
|
${pname}_status "IDLE"
|
|
}
|
|
}]
|
|
sicslist setatt $pname units $units
|
|
sicslist setatt $pname long_name $pname
|
|
sicslist setatt $pname klass derived_parameter
|
|
# sicslist setatt $pname depends $motor
|
|
# TODO SICS-198 add feedback support to getset macro generator
|
|
VarMake ${pname}_status text user
|
|
${pname}_status "IDLE"
|
|
}
|
|
|
|
foreach {pname motor units} {
|
|
RotApDeg srce degrees
|
|
} {
|
|
::utility::macro::getset float $pname {args} [subst -nocommands {
|
|
if {[set args] == ""} {
|
|
return [sicsmsgfmt [SplitReply [$motor]]]
|
|
} else {
|
|
set target [lindex [set args] 0]
|
|
RotApXmm 0
|
|
RotApZmm 0
|
|
RotApShape "UNKNOWN"
|
|
EApXmm 0
|
|
EApZmm 0
|
|
EApShape "UNKNOWN"
|
|
${pname}_status "BUSY"
|
|
drive $motor \$target
|
|
set motpos [SplitReply [$motor]]
|
|
set tolerance [SplitReply [$motor precision] ]
|
|
if {[expr abs(\$motpos - \$target)] > \$tolerance} {
|
|
${pname}_status "IDLE"
|
|
error "ERROR: failed to set $pname target \$target"
|
|
} else {
|
|
set size [::optics::EApLookUp \$target "size"]
|
|
set shape [::optics::EApLookUp \$target "shape"]
|
|
RotApXmm \$size
|
|
RotApZmm \$size
|
|
RotApShape \$shape
|
|
EApXmm \$size
|
|
EApZmm \$size
|
|
EApShape \$shape
|
|
}
|
|
${pname}_status "IDLE"
|
|
}
|
|
}]
|
|
sicslist setatt $pname units $units
|
|
sicslist setatt $pname long_name $pname
|
|
sicslist setatt $pname klass derived_parameter
|
|
# sicslist setatt $pname depends $motor
|
|
# TODO SICS-198 add feedback support to getset macro generator
|
|
VarMake ${pname}_status text user
|
|
${pname}_status "IDLE"
|
|
}
|
|
################################################################################
|
|
::hdb::MakeAperture sample_aperture {
|
|
shape SApShape
|
|
size {SApXmm SApZmm}
|
|
coordinate_scheme SApCoordScheme
|
|
position {SApPosXmm SApPosYmm SApPosZmm}
|
|
}
|
|
|
|
::hdb::MakeAperture entrance_aperture {
|
|
shape EApShape
|
|
size {EApXmm EApYmm EApZmm}
|
|
coordinate_scheme EApCoordScheme
|
|
position EApPosYmm
|
|
}
|
|
|
|
::hdb::MakeAperture rotary_aperture {
|
|
shape RotApShape
|
|
size {RotApXmm RotApZmm}
|
|
position RotApPosYmm
|
|
orientation RotApDeg
|
|
}
|
|
|
|
#::hdb::MakeGeometry sample_geometry sample {
|
|
# coordinate_scheme SampleCoordScheme
|
|
# position {SamplePosXmm SamplePosYmm SamplePosZmm}
|
|
# orientation {SampleTiltXDeg SampleTiltYDeg SampleRotDeg}
|
|
#}
|
|
|
|
::hdb::MakeGeometry detector_geometry detector {
|
|
coordinate_scheme DetCoordScheme
|
|
position {DetPosXmm DetPosYmm}
|
|
offset DetPosYOffsetmm
|
|
}
|
|
|
|
::hdb::MakeGeometry collimator_geometry collimator {
|
|
coordinate_scheme CollCoordScheme
|
|
position EndFacePosYmm
|
|
}
|
|
|
|
::hdb::MakeGeometry beamstop_geometry beam_stop {
|
|
shape BSShape
|
|
position {BSPosXmm BSPosZmm}
|
|
size {BSXmm BSZmm}
|
|
}
|
|
|
|
# INITIALISE PARAMETERS
|
|
# The collimation system aperture positions
|
|
# Reference position is outer wall of velocity selector bunker, ie VelSelPosYmm
|
|
array set collapposmm {
|
|
inputguide 633
|
|
apwheel 675
|
|
ap1 4929
|
|
ap2 6934
|
|
ap3 8949
|
|
ap4 10955
|
|
ap5 12943
|
|
ap6 14970
|
|
ap7 16971
|
|
ap9 19925
|
|
}
|
|
|
|
EndFacePosYmm 20095
|
|
RotApPosYmm 675
|
|
|
|
################################################################################
|
|
# Check Config
|
|
namespace eval parameters {
|
|
set paramlist {
|
|
AttFactor
|
|
AttRotDeg
|
|
BS1
|
|
BS2
|
|
BS3
|
|
BS4
|
|
BS5
|
|
BSPosXmm
|
|
BSPosZmm
|
|
BSShape
|
|
BSXmm
|
|
BSZmm
|
|
C1
|
|
C2
|
|
C3
|
|
C4
|
|
C5
|
|
C6
|
|
C7
|
|
C8
|
|
C9
|
|
DetPosXmm
|
|
DetPosYmm
|
|
DetPosYOffsetmm
|
|
EApPosYmm
|
|
EApShape
|
|
EApShape
|
|
EApXmm
|
|
EApYmm
|
|
EApZmm
|
|
EndFacePosYmm
|
|
L1mm
|
|
L2mm
|
|
LambdaA
|
|
LambdaResFWHM_percent
|
|
Pent
|
|
Plexmm
|
|
RotApDeg
|
|
RotApShape
|
|
RotApXmm
|
|
RotApZmm
|
|
SampleAttributes
|
|
SampleComments
|
|
SampleName
|
|
SampleNum
|
|
SamplePosXmm
|
|
SamplePosYmm
|
|
SamplePosZmm
|
|
SampleRotDeg
|
|
SampleTiltXDeg
|
|
SampleTiltYDeg
|
|
SampleTitle
|
|
SApPosXmm
|
|
SApPosYmm
|
|
SApPosZmm
|
|
SApShape
|
|
SApXmm
|
|
SApZmm
|
|
VSdeg
|
|
VSrpm
|
|
}
|
|
}
|
|
##
|
|
# @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
|
|
|