hipadaba_configuration_common.tcl
Oops calling the deleted hlistplainprop function instead of the new hlistprop. sans/config/commands/commands.tcl Set beamstop diameter (BSdiam) when selecting a beamstop sans optics/aperture_configuration.tcl The entrance app is 50mm when guide config is g1 to g9 or p1 to p9 sans parameters.tcl Added GuideConfig parameter to record the last configuration set by SICS. r2870 | ffr | 2010-01-15 18:19:22 +1100 (Fri, 15 Jan 2010) | 12 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
59101a7d4d
commit
724af2d4ca
@@ -403,26 +403,29 @@ proc ::hdb::add_subtree {hpath subtree {object @none} {type @none} {makenode @no
|
||||
# @param dtype The new hdb node will have this type
|
||||
# @param dlen Array length if the hdb node represents array data
|
||||
proc ::hdb::add_hpath {basePath path {priv spy} {dtype none} {dlen ""}} {
|
||||
set parent $basePath
|
||||
array set prop_arr [::utility::hlistplainprop $basePath]
|
||||
foreach child [split $path /] {
|
||||
if {[lsearch [hlist $parent] $child] == -1} {
|
||||
hmake $parent/$child $priv $dtype $dlen
|
||||
if {$basePath != "/"} {
|
||||
hsetprop $parent/$child data $prop_arr(data)
|
||||
hsetprop $parent/$child control $prop_arr(control)
|
||||
hsetprop $parent/$child nxsave $prop_arr(nxsave)
|
||||
hsetprop $parent/$child klass @none
|
||||
hsetprop $parent/$child type $prop_arr(type)
|
||||
set catch_status [ catch {
|
||||
set parent $basePath
|
||||
array set prop_arr [hlistprop $basePath tcllist]
|
||||
foreach child [split $path /] {
|
||||
if {[lsearch [hlist $parent] $child] == -1} {
|
||||
hmake $parent/$child $priv $dtype $dlen
|
||||
if {$basePath != "/"} {
|
||||
hsetprop $parent/$child data $prop_arr(data)
|
||||
hsetprop $parent/$child control $prop_arr(control)
|
||||
hsetprop $parent/$child nxsave $prop_arr(nxsave)
|
||||
hsetprop $parent/$child klass @none
|
||||
hsetprop $parent/$child type $prop_arr(type)
|
||||
}
|
||||
}
|
||||
if {$parent == "/"} {
|
||||
set parent /$child
|
||||
} else {
|
||||
set parent $parent/$child
|
||||
}
|
||||
}
|
||||
if {$parent == "/"} {
|
||||
set parent /$child
|
||||
} else {
|
||||
set parent $parent/$child
|
||||
}
|
||||
}
|
||||
return $parent
|
||||
return $parent
|
||||
} message ]
|
||||
handle_exception $catch_status $message
|
||||
}
|
||||
|
||||
##
|
||||
@@ -466,7 +469,7 @@ proc ::hdb::add_node {basePath args} {
|
||||
variable sobjadd_state
|
||||
|
||||
array unset arg_array
|
||||
if [ catch {
|
||||
set catch_status [ catch {
|
||||
array set arg_array $args
|
||||
if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} {
|
||||
add_hpath $basePath $arg_array(path)
|
||||
@@ -582,10 +585,8 @@ proc ::hdb::add_node {basePath args} {
|
||||
}
|
||||
return $node_path
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
} message ]
|
||||
handle_exception $catch_status $message
|
||||
}
|
||||
|
||||
##
|
||||
@@ -681,7 +682,7 @@ proc ::hdb::sobjadd {hpath sobj args} {
|
||||
# TODO Check if args parameter needs to be here, it might be there in case the function is called
|
||||
# with more than two arguments.
|
||||
array unset sobjatt
|
||||
if [ catch {
|
||||
set catch_status [ catch {
|
||||
array set sobjatt [attlist $sobj]
|
||||
if {[sicslist exists $sobj id] == false} {
|
||||
sicslist setatt $sobj id $sobj
|
||||
@@ -802,10 +803,8 @@ proc ::hdb::sobjadd {hpath sobj args} {
|
||||
error "ERROR: Unknown sics object type $sobjatt(type)"
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
} message ]
|
||||
handle_exception $catch_status $message
|
||||
}
|
||||
proc ::hdb::write_poll {pollnode val} {
|
||||
hsetprop $pollnode poll_interval $val
|
||||
@@ -825,7 +824,7 @@ proc ::hdb::read_poll {pollnode} {
|
||||
# @param given_klass A klass in instdict_specification.tcl
|
||||
# @see sobjadd
|
||||
proc ::hdb::sobjtypeadd {hpath sobjtype given_klass} {
|
||||
if [ catch {
|
||||
set catch_status [ catch {
|
||||
foreach {sobj} [sobjlist $sobjtype $given_klass] {
|
||||
array unset sobjatt
|
||||
array set sobjatt [attlist $sobj]
|
||||
@@ -833,10 +832,8 @@ proc ::hdb::sobjtypeadd {hpath sobjtype given_klass} {
|
||||
sobjadd $hpath $sobj
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
} message ]
|
||||
handle_exception $catch_status $message
|
||||
}
|
||||
|
||||
|
||||
@@ -903,7 +900,7 @@ proc ::hdb::prune {instdict} {
|
||||
proc ::hdb::buildHDB {instDict} {
|
||||
#TODO add data control nxsave nxtyp properties
|
||||
upvar #0 $instDict dictionary
|
||||
if [ catch {
|
||||
set catch_status [ catch {
|
||||
prune dictionary
|
||||
foreach {n v} $dictionary {
|
||||
array unset varr
|
||||
@@ -917,10 +914,8 @@ upvar #0 $instDict dictionary
|
||||
}
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
} message ]
|
||||
handle_exception $catch_status $message
|
||||
}
|
||||
|
||||
##
|
||||
|
||||
@@ -56,31 +56,37 @@ proc selbs {bs {bx "UNDEF"} {bz "UNDEF"}} {
|
||||
"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 {
|
||||
@@ -95,9 +101,11 @@ proc selbs {bs {bx "UNDEF"} {bz "UNDEF"}} {
|
||||
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]}
|
||||
@@ -114,9 +122,11 @@ proc selbs {bs {bx "UNDEF"} {bz "UNDEF"}} {
|
||||
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]}
|
||||
@@ -177,6 +187,7 @@ namespace eval optics {
|
||||
|
||||
variable guide_configuration
|
||||
variable guide_configuration_columns
|
||||
|
||||
if [ catch {
|
||||
|
||||
foreach {compselection position} $guide_configuration($configuration) {
|
||||
@@ -188,6 +199,7 @@ namespace eval optics {
|
||||
set msg [eval "drive $to_config"]
|
||||
EApPosYmm $position
|
||||
}
|
||||
GuideConfig $configuration
|
||||
} message ] {
|
||||
::optics::guide -set feedback status IDLE
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
|
||||
@@ -48,15 +48,22 @@ proc ::optics::AttRotLookup {angle} {
|
||||
|
||||
proc ::optics::EApLookUp {angle param} {
|
||||
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 int($angle)]} {
|
||||
set foundit true
|
||||
|
||||
@@ -14,6 +14,7 @@ foreach {var lname type priv units klass} {
|
||||
DetPosYOffset DetPosYOffsetfloat 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
|
||||
|
||||
Reference in New Issue
Block a user