310 lines
8.8 KiB
Tcl
310 lines
8.8 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 nxname} {
|
|
VelSelCoordScheme coordinate_scheme
|
|
SApCoordScheme coordinate_scheme
|
|
EApCoordScheme coordinate_scheme
|
|
SampleCoordScheme coordinate_scheme
|
|
DetCoordScheme coordinate_scheme
|
|
BeamstopCoordScheme coordinate_scheme
|
|
CollCoordScheme coordinate_scheme
|
|
} {
|
|
::utility::mkVar $var text readonly $var true @none false true
|
|
$var Cartesian
|
|
$var lock
|
|
}
|
|
|
|
##
|
|
# @brief User privilege text variables
|
|
#
|
|
# TODO SICS-117 Redo as get/set macros like the "kind=command" macros but kind=getset and it is saveable
|
|
# The set parameter will have a domain. If the param is readonly then the hdb privilege is readonly
|
|
# Pros, GumTree will know the data type of the parameter (text params will have a list of valid values).
|
|
# Cons, There is no "instant" feedback, macros are polled on the hdb tree.
|
|
foreach {var nxname priv} {
|
|
EApShape shape user
|
|
RotApshape shape readonly
|
|
SApShape shape readonly
|
|
BSShape shape user
|
|
} {
|
|
::utility::mkVar $var text $priv $var true @none true true
|
|
}
|
|
|
|
# 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 nxname units} {
|
|
VelSelPosXmm x mm
|
|
VelSelPosYmm y mm
|
|
VelSelPosZmm z mm
|
|
EndFacePosYmm y mm
|
|
RotApPosYmm y mm
|
|
} {
|
|
::utility::mkVar $var float readonly $var true @none true true
|
|
if {$units != 1} {
|
|
sicslist setatt $var units $units
|
|
}
|
|
}
|
|
|
|
::utility::mkVar SampleNum int readonly changer_position true sample true true
|
|
|
|
foreach {var nxname units priv} {
|
|
LambdaA wavelength nm user
|
|
LambdaResFWHM% wavelength_spread 1 user
|
|
VSdeg twist degrees user
|
|
VSrpm rotation_speed rpm user
|
|
AttFactor attenuation_factor 1 user
|
|
AttRotDeg AttRotDeg degrees readonly
|
|
PleXmm x mm user
|
|
RotApXmm x mm user
|
|
RotApZmm z mm user
|
|
RotApDeg RotApDeg degrees readonly
|
|
EApXmm x mm user
|
|
EApYmm y mm user
|
|
EApZmm z mm user
|
|
EApPosYmm y mm user
|
|
SApXmm x mm readonly
|
|
SApZmm z mm readonly
|
|
SApPosXmm x mm user
|
|
SApPosYmm y mm user
|
|
SApPosZmm z mm user
|
|
SamplePosXmm x mm user
|
|
SamplePosYmm y mm user
|
|
SamplePosZmm z mm user
|
|
SampleRotDeg SampleRotDeg degrees user
|
|
SampleTiltXdeg SampleTiltXdeg degrees user
|
|
SampleTiltYdeg SampleTiltYdeg degrees user
|
|
DetPosYOffsetmm detposyoffset mm user
|
|
BSXmm x mm user
|
|
BSZmm z mm user
|
|
} {
|
|
::utility::mkVar $var float $priv $var true @none true true
|
|
if {$units != 1} {
|
|
sicslist setatt $var units $units
|
|
}
|
|
}
|
|
|
|
proc sicsmsgfmt {args} {return "[info level -1] = $args"}
|
|
::utility::macro::getset float L1mm {} {
|
|
set efpy [SplitReply [EndFacePosYmm]]
|
|
set sapy [SplitReply [SApPosYmm]]
|
|
set eapy [SplitReply [EApPosYmm]]
|
|
return [sicsmsgfmt [expr {$efpy + $sapy - $eapy}]]
|
|
}
|
|
sicslist setatt L1mm klass sample
|
|
sicslist setatt L1mm long_name eap_sap_dist
|
|
sicslist setatt L1mm units mm
|
|
|
|
::utility::macro::getset float L2mm {} {
|
|
set detpy [SplitReply [DetPosYmm]]
|
|
set detpyos [SplitReply [DetPosYOffsetmm]]
|
|
set sapy [SplitReply [SamplePosYmm]]
|
|
return [sicsmsgfmt [expr {$detpyos + $detpyos - $sapy}]]
|
|
}
|
|
sicslist setatt L2mm klass detector
|
|
sicslist setatt L2mm long_name sample_det_dist
|
|
sicslist setatt L2mm units mm
|
|
|
|
foreach {pname motor hdbname units} {
|
|
DetPosXmm detoff x mm
|
|
DetPosYmm det y mm
|
|
BSPosXmm bsx x mm
|
|
BSPosZmm bsz z mm
|
|
} {
|
|
::utility::macro::getset float $pname {} [subst -nocommands {
|
|
return [sicsmsgfmt [SplitReply [$motor]]]
|
|
}]
|
|
sicslist setatt $pname units $units
|
|
sicslist setatt $pname long_name $pname
|
|
}
|
|
|
|
################################################################################
|
|
##
|
|
# @brief This is the position of the velocity selector bunker face. It is used
|
|
# as the reference for other positions. x=y=z=0.
|
|
::hdb::MakeVelocity_Selector velocity_selector {
|
|
wavelength LambdaA
|
|
wavelength_spread LambdaResFWHM%
|
|
coordinate_scheme VelSelCoordScheme
|
|
position {VelSelPosXmm VelSelPosYmm VelSelPosZmm}
|
|
}
|
|
|
|
::hdb::MakeAperture sample_aperture {
|
|
shape SApShape
|
|
size {SApXmm SApZmm}
|
|
coordinate_scheme SApCoordScheme
|
|
position {SApPosXmm SApPosYmm SApPosZmm}
|
|
refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm}
|
|
}
|
|
|
|
::hdb::MakeAperture entrance_aperture {
|
|
shape EApShape
|
|
size {EApXmm EApYmm EApZmm}
|
|
coordinate_scheme EApCoordScheme
|
|
position EApPosYmm
|
|
refpos VelSelPosYmm
|
|
}
|
|
|
|
::hdb::MakeAperture rotary_aperture {
|
|
shape RotApShape
|
|
size {RotApXmm RotApZmm}
|
|
position RotApPosYmm
|
|
orientation RotApDeg
|
|
refpos VelSelPosYmm
|
|
}
|
|
|
|
::hdb::MakeGeometry sample_geometry sample {
|
|
coordinate_scheme SampleCoordScheme
|
|
position {SamplePosXmm SamplePosYmm SamplePosZmm}
|
|
orientation {SampleTiltXdeg SampleTiltYdeg SampleRotDeg}
|
|
refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm}
|
|
}
|
|
|
|
::hdb::MakeGeometry detector_geometry detector {
|
|
coordinate_scheme DetCoordScheme
|
|
position {DetPosXmm DetPosYmm}
|
|
offset DetPosYOffsetmm
|
|
refpos {VelSelPosXmm EndFacePosYmm}
|
|
}
|
|
|
|
::hdb::MakeGeometry collimator_geometry collimator {
|
|
coordinate_scheme CollCoordScheme
|
|
position EndFacePosYmm
|
|
refpos VelSelPosYmm
|
|
}
|
|
|
|
::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
|
|
}
|
|
|
|
VelSelPosXmm 0.0
|
|
VelSelPosYmm 0.0
|
|
VelSelPosZmm 0.0
|
|
EndFacePosYmm 20095
|
|
RotApPosYmm 675
|
|
|
|
################################################################################
|
|
# Check Config
|
|
namespace eval parameters {
|
|
set paramlist {
|
|
AttRotDeg
|
|
BS1
|
|
BS2
|
|
BS3
|
|
BS4
|
|
BS5
|
|
BSPosXmm
|
|
BSPosZmm
|
|
BSShape
|
|
BSXmm
|
|
BSZmm
|
|
C1
|
|
C2
|
|
C3
|
|
C4
|
|
C5
|
|
C6
|
|
C7
|
|
C8
|
|
C9
|
|
DetPosXmm
|
|
DetPosYmm
|
|
DetPosYmm
|
|
DetPosYOffsetmm
|
|
EApPosYmm
|
|
EApShape
|
|
EApXmm
|
|
EApYmm
|
|
EApZmm
|
|
EndFacePosYmm
|
|
LambdaA
|
|
LambdaResFWHM%
|
|
Pent
|
|
Plexmm
|
|
RotApDeg
|
|
RotApShape
|
|
RotApXmm
|
|
RotApZmm
|
|
SampleAttributes
|
|
SampleComments
|
|
SampleName
|
|
SampleNum
|
|
SamplePosXmm
|
|
SamplePosYmm
|
|
SamplePosYmm
|
|
SamplePosZmm
|
|
SampleRotDeg
|
|
SampleTiltXDeg
|
|
SampleTiltYDeg
|
|
SampleTitle
|
|
SApPosXmm
|
|
SApPosYmm
|
|
SApPosYmm
|
|
SApPosZmm
|
|
SApShape
|
|
SApXmm
|
|
SApZmm
|
|
VSdeg
|
|
VSrpm
|
|
}
|
|
foreach p $paramlist {
|
|
if [::utility::obj_exists $p] {
|
|
sicslist setatt $p klass parameter
|
|
}
|
|
}
|
|
set derived_paramlist {
|
|
AttFactor
|
|
L1mm
|
|
L2mm
|
|
}
|
|
foreach p $derived_paramlist {
|
|
if [::utility::obj_exists $p] {
|
|
sicslist setatt $p klass derived_parameter
|
|
}
|
|
}
|
|
}
|
|
##
|
|
# @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"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Check list
|
|
proc check {args} {
|
|
switch $args {
|
|
"missing" {
|
|
missingparams
|
|
}
|
|
}
|
|
}
|
|
publish check user
|