From 724af2d4ca9dc9996e01d01bde923cd8bb0e5224 Mon Sep 17 00:00:00 2001 From: Ferdi Franceschini Date: Fri, 15 Jan 2010 18:19:22 +1100 Subject: [PATCH] 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 --- .../hipadaba_configuration_common.tcl | 71 +++++++++---------- .../sans/config/commands/commands.tcl | 12 ++++ .../config/optics/aperture_configuration.tcl | 9 ++- .../sans/config/parameters/parameters.tcl | 1 + 4 files changed, 54 insertions(+), 39 deletions(-) diff --git a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl index f6a06ff3..9e840e97 100644 --- a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl +++ b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl @@ -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 } ## diff --git a/site_ansto/instrument/sans/config/commands/commands.tcl b/site_ansto/instrument/sans/config/commands/commands.tcl index bfd1d925..ccf6079a 100644 --- a/site_ansto/instrument/sans/config/commands/commands.tcl +++ b/site_ansto/instrument/sans/config/commands/commands.tcl @@ -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} diff --git a/site_ansto/instrument/sans/config/optics/aperture_configuration.tcl b/site_ansto/instrument/sans/config/optics/aperture_configuration.tcl index a53d6ba7..ffc024cf 100644 --- a/site_ansto/instrument/sans/config/optics/aperture_configuration.tcl +++ b/site_ansto/instrument/sans/config/optics/aperture_configuration.tcl @@ -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 diff --git a/site_ansto/instrument/sans/config/parameters/parameters.tcl b/site_ansto/instrument/sans/config/parameters/parameters.tcl index 5f9a881c..63b4ca90 100644 --- a/site_ansto/instrument/sans/config/parameters/parameters.tcl +++ b/site_ansto/instrument/sans/config/parameters/parameters.tcl @@ -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