diff --git a/site_ansto/instrument/MANIFEST.TXT b/site_ansto/instrument/MANIFEST.TXT index 6f97f395..8e6ea31f 100644 --- a/site_ansto/instrument/MANIFEST.TXT +++ b/site_ansto/instrument/MANIFEST.TXT @@ -1,3 +1,4 @@ server_config.tcl util gumxml.tcl +config/hmm/anstohm_linked.xml diff --git a/site_ansto/instrument/config/counter/counter_common_1.tcl b/site_ansto/instrument/config/counter/counter_common_1.tcl index bf9bf268..27bcf6a8 100644 --- a/site_ansto/instrument/config/counter/counter_common_1.tcl +++ b/site_ansto/instrument/config/counter/counter_common_1.tcl @@ -1 +1,23 @@ bm SetExponent 0 +sicslist setatt bm privilege internal +namespace eval monitor { + command count {text:timer,monitor mode float: preset} { + #FIXME remove dependency on hdb path + ::monitor::count -set feedback status BUSY + bm setmode $mode + bm count $preset + ::monitor::count -set feedback counts [SplitReply [bm getcounts]]; + ::monitor::count -set feedback status IDLE + array set param [::data::gumtree_save -list param] + data axis 1 $param(run_number) + data data_set [::utility::hgetplainprop /instrument/monitor/counts sicsdev] + ::hdb::set_save /instrument/monitor true + ::hdb::set_save /data true + ::hdb::set_save /instrument/detector false + } + ::monitor::count -addfb int counts text status + ::monitor::count -set feedback status IDLE + array set fbarr [::monitor::count -list feedback] + ::utility::mkData $fbarr(counts) counts monitor privilege user mutable true + array unset fbarr +} diff --git a/site_ansto/instrument/config/hipadaba/common_hipadaba_configuration.tcl b/site_ansto/instrument/config/hipadaba/common_hipadaba_configuration.tcl deleted file mode 100644 index 24ae0d23..00000000 --- a/site_ansto/instrument/config/hipadaba/common_hipadaba_configuration.tcl +++ /dev/null @@ -1,102 +0,0 @@ -# Defines hashes which map SICS device object names to hipadaba paths -InstallHdb -#Usage: xhmake /a/b spy none {type part} -proc xhmake {path priv dtype pKey pVal} { - global pathlist; - if {[info exists pathlist($path)] == 0} { - set basepath ""; - foreach p [split [string trimleft $path / ] / ] { - if {[info exists pathlist($basepath/$p)] == 1} { - append basepath /$p; - continue; - } - hmake $basepath/$p $priv $dtype; - hsetprop $basepath/$p $pKey $pVal; - set pathlist($basepath/$p) 1; - append basepath /$p; - } - } -} - -hmake /commands spy none -set pathlist(/commands) 1 -hsetprop /commands type commandset -hmake /graphics spy none -set pathlist(/graphics) 1 -hsetprop /graphics type graphset -hsetprop /commands type commandset - - -#TODO change this to hparts.tcl -source $cfPath(hipadaba)/hpaths.tcl -set instrument [string tolower [SplitReply [Instrument]] ] -hmake /$instrument spy none -hsetprop /$instrument type instrument -set pathlist(/$instrument) 1 -hmake /$instrument/status spy none -set pathlist(/$instrument/status) 1 -hsetprop /$instrument/status type part - -# Generate hipadaba nodes for the paths in the hpaths file -foreach hp $hpaths { - hmake /$instrument/$hp spy none; - hsetprop /$instrument/$hp type part; - set pathlist(/$instrument/$hp) 1; -} - -#--- admin -hmake /experiment user none -set pathlist(/experiment) 1 -hattach /experiment title title -hattach /experiment sample description -hmake /experiment/user spy none -hsetprop /experiment/user type part -set pathlist(/experiment/user) 1 -hattach /experiment/user user name -hattach /experiment/user email email -hattach /experiment/user phone phone -hattach /experiment dataFileName datafile - -#--- Motors -foreach {type path} $motor_hpath { - if {[info exists pathlist(/$instrument/$path)] == 0} { - hmake /$instrument/$path spy none; - hsetprop /$instrument/$path type part; - set pathlist(/$instrument/$path) 1; - } -} - -array set mot_Pdic $motor_hpath; -foreach motor [sicslist type motor] { - if {$motor == "motor"} {continue} - set mpart [SplitReply [$motor part]]; - foreach {type group} [split $mpart .] {}; - set path $mot_Pdic($type); - if {$group != ""} { - append path /$group; - } - xhmake /$instrument/$path spy none type part; - hattach /$instrument/$path $motor [SplitReply [$motor long_name]]; -} - -#--- Configurable Virtual Motors -foreach {obj name part master_obj} $cvirtmotor_hpath { - set path /$instrument/$part - hattach $path $obj $name - foreach m $master_obj { - hchain $path/$name $path/$m - } - #FIXME polling causes scans to abort - #sicspoll add $path/$name hdb 2 -} - - -#------------- scan command -::scancommand::commands_hpath_setup /commands -::scancommand::graphics_hpath_setup /graphics -::scancommand::init - -#------------- plc controller -::plc::status_hpath_setup /$instrument/status - -unset pathlist; diff --git a/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl b/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl new file mode 100644 index 00000000..b3ac585b --- /dev/null +++ b/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl @@ -0,0 +1,108 @@ +# Root (ie /) only provides the starting point for traversing the instrument dictionary. +#set instrument_name [string trim [lindex [split [instrument] =] 1]] +set instrument_name instrument +# / { +# children {commands graphics instrument experiment } +# property {data true control true nxsave true klass NXentry} +# } + +# / Must be the first node in the list +set instrument_dictionary [subst { + commands { + sobj {macro command} + privilege spy + datatype @none + property {data false control true nxsave false klass @none type commandset} + } + graphics { + sobj {@any graphics} + privilege spy + datatype @none + property {data true control true nxsave false klass @none type graphset} + } + instrument { + sobj {@any instrument} + privilege spy + datatype @none + property {data true control true nxsave false klass NXinstrument type instrument} + } + instrument/status { + privilege spy + sobj {@any plc} + datatype @none + property {data false control true nxsave false klass @none type part} + } + instrument/detector { + privilege spy + sobj {@any detector} + datatype @none + property {data true control true nxsave false klass NXdetector type part} + } + instrument/sample { + privilege spy + sobj {@any sample} + datatype @none + property {data true control true nxsave false klass NXsample type part} + } + instrument/collimator { + privilege spy + sobj {@any collimator} + datatype @none + property {data true control true nxsave false klass NXcollimator type part} + } + instrument/monitor { + privilege spy + sobj {@any monitor} + datatype @none + property {data true control true nxsave false klass NXmonitor type part} + } + instrument/monochromator { + privilege spy + sobj {@any monochromator @any crystal} + datatype @none + property {data true control true nxsave false klass NXcrystal type part} + } + instrument/slits { + privilege spy + sobj {@any aperture} + datatype @none + property {data true control true nxsave false klass NXfilter type part} + } + experiment { + privilege spy + sobj {@any user @any experiment} + datatype @none + property {data true control true nxsave false klass NXentry type part} + } + data { + privilege spy + sobj {@any data} + datatype @none + property {data true control false nxsave false klass NXdata type part datatype UNKNOWN} + } + data/data_set { + privilege spy + datatype @none + property {data true control false nxsave false klass @none type nxvgroup nxalias data_set link @none} + } + data/axis_1 { + privilege spy + datatype @none + property {data true control false nxsave false klass @none type nxvgroup nxalias axis_1 link @none} + } + data/axis_2 { + privilege spy + datatype @none + property {data true control false nxsave false klass @none type nxvgroup nxalias axis_2 link @none} + } + data/axis_3 { + privilege spy + datatype @none + property {data true control false nxsave false klass @none type nxvgroup nxalias axis_3 link @none} + } + data/axis_4 { + privilege spy + datatype @none + property {data true control false nxsave false klass @none type nxvgroup nxalias axis_4 link @none} + } +}] diff --git a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl new file mode 100644 index 00000000..c3da97f2 --- /dev/null +++ b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl @@ -0,0 +1,434 @@ +## \file hipadaba_configuration_common.tcl +# \brief Commands for building the hdb tree from sics object properties and an instrument dictionary. +# +# hobj policy: data=false control=parent nxsave=false klass=parent +# subtree/group_path policy: data=parent control=parent nxsave=parent klass=parent +# type=macro & klass=command -> kind=command +# type=macro & klass!=command -> kind=script + +source $cfPath(hipadaba)/instdict_specification.tcl +source $cfPath(hipadaba)/common_instrument_dictionary.tcl + +InstallHdb + +# TODO only use add_node to add hpaths and nodes, +# eg add_node / path beam_monitor_scan prop_list {data true ...} + +# eventid=source/type, type={parameter feedback graphics} eg hdb_bmonscan/feedback +proc update_node {name eventid access} { + global nodeindex + upvar $name signal + hset $nodeindex($eventid) $signal($eventid) +} + +proc 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) + } + } + if {$parent == "/"} { + set parent /$child + } else { + set parent $parent/$child + } + } + return $parent +} + +proc add_cmd_par {hpath sobj name} { + hattach $hpath $sobj $name + #array set property [attlist $sobj] +# hsetprop $hpath/$name argtype $property(argtype) + foreach {prop pval} [attlist $sobj] { + hsetprop $hpath/$name $prop $pval + } + hsetprop $hpath/$name data false +# if {[info exists property(values)]} { +# hsetprop $hpath/$name values $property(values) +# } +# if {[info exists property(min)]} { +# hsetprop $hpath/$name min $property(min) +# } +# if {[info exists property(max)]} { +# hsetprop $hpath/$name max $property(max) +# } +} + +proc add_feedback {hpath sobj name} { + hattach $hpath $sobj $name + foreach {prop pval} [attlist $sobj] { + hsetprop $hpath/$name $prop $pval + } + hsetprop $hpath/$name privilege READ_ONLY +} + +# args is an optional set of properties as name/value pairs. +# need node kind +proc add_node {basePath args} { + global nodeindex + array unset arg_array + array set arg_array $args; + + if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} { + add_hpath $basePath $arg_array(path) + if {$basePath == "/"} { + set node_path /$arg_array(path) + } else { + set node_path $basePath/$arg_array(path) + } + # if {[info exists arg_array(prop_list)]} { + foreach {prop pval} $arg_array(prop_list) { + hsetprop $node_path $prop $pval + } + # } + return $node_path + } + + if {![info exists arg_array(dlen)]} { + set arg_array(dlen) "" + } + set gp_path [file dirname $arg_array(node)] + set node_name [file tail $arg_array(node)] + if {$gp_path != "."} { + add_hpath $basePath $gp_path + set basePath $basePath/$gp_path + hsetprop $basePath type part + } + if {[lsearch [hlist $basePath] $node_name] == -1} { + #TODO allow hdb nodes of type drivable countable environment + switch $arg_array(kind) { + command { + # A command is a macro, node=macro name + set command $node_name + set cmd_path [add_command $basePath $command] + set node_path $cmd_path + # The extra arguments for add_node are supplied by the command parameters + # and command feedback procedures. + if {[string length [info procs ${command}_parameters]] > 0} { + ${command}_parameters add_node $cmd_path + } else { + $command -map param add_cmd_par $cmd_path + } + if {[string length [info procs ${command}_feedback]] > 0} { + add_hpath $cmd_path feedback + hsetprop $cmd_path/feedback type part + ${command}_feedback add_node $cmd_path/feedback + } else { + add_hpath $cmd_path feedback + hsetprop $cmd_path/feedback type part + $command -map feedback add_feedback $cmd_path/feedback + } + } + event { + # An event is a data array, node= a node path + add_hpath $basePath $node_name $arg_array(priv) $arg_array(dtype) $arg_array(dlen) + set node_path $basePath/$node_name + set nodeindex($arg_array(eventid),$arg_array(node)) $node_path + } + hobj { + hattach $basePath $node_name $arg_array(long_name) + set node_path $basePath/$arg_array(long_name) + hsetprop $node_path data [getatt $node_name data] + hsetprop $node_path control [getatt $node_name control] + hsetprop $node_path nxsave [getatt $node_name nxsave] + hsetprop $node_path klass [getatt $node_name klass] + foreach child [hlist $node_path] { + hsetprop $node_path/$child data false + hsetprop $node_path/$child control [getatt $node_name control] + hsetprop $node_path/$child nxsave false + hsetprop $node_path/$child klass [getatt $node_name klass] + } + } + ilist { + set node_path $basePath + set ilist_proc $node_name + $ilist_proc add_node $node_path + } + script { + # A r/w pair of scripts, node = a node path + set node_path $basePath/$node_name + hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen) + } + } + if {[info exists arg_array(prop_list)]} { + foreach {prop pval} $arg_array(prop_list) { + hsetprop $node_path $prop $pval + } + } + return $node_path + } +} + +# Add command +proc add_command {basePath command} { + array unset cmd_atts + array set cmd_atts [attlist $command] + if 0 { + if {[info exists cmd_atts(group)]} { + add_hpath $basePath $cmd_atts(group) + set basePath $basePath/$cmd_atts(group) + hsetprop $basePath type part + } + } + hcommand $basePath/$cmd_atts(long_name) $command + set cmd_ns [namespace qualifiers $command] + if {[llength [trace info variable ::${cmd_ns}::event]] == 0} { + trace add variable ::${cmd_ns}::event write update_node + } + set cmd_path $basePath/$cmd_atts(long_name) + hsetprop $cmd_path privilege $cmd_atts(privilege) + hsetprop $cmd_path type $cmd_atts(kind) + hsetprop $cmd_path data $cmd_atts(data) + hsetprop $cmd_path control $cmd_atts(control) + hsetprop $cmd_path klass $cmd_atts(klass) + hsetprop $cmd_path nxsave $cmd_atts(nxsave) + return $cmd_path +} + +# attlist +# return a list of name value pairs for the sicsobj attributes +proc attlist {sicsobj} { + foreach att [tolower_sicslist $sicsobj] { + lappend atts [split [string range $att 0 end-1] =] + } + return [join $atts] +} + +# List sics objects with the given sics type, klass and group +proc sobjlist {atype aklass} { + global sobj_sicstype_list + + switch $atype { + command,macro { + return [intersection [tolower_sicslist type macro] [tolower_sicslist klass $aklass] [tolower_sicslist kind command]] + } + script,macro { + return [intersection [tolower_sicslist type macro] [tolower_sicslist klass $aklass] [tolower_sicslist kind script]] + } + "@any" { + foreach st $sobj_sicstype_list { + lappend sobjects [tolower_sicslist type $st] + } + return [intersection [join $sobjects] [tolower_sicslist klass $aklass]] + } + default { + return [intersection [tolower_sicslist type $atype] [tolower_sicslist klass $aklass]] + } + } +} + +proc getsobjatt {sicsobj attribute} { + string trim [lindex [join [split [tolower_sicslist $sicsobj $attribute] =]] 1] +} + + +# Add the given sics object (sobj) of sobjtype to the +# given hipadaba path hpath. +# hpath must exist. +proc sobjadd {hpath sobj args} { + array unset sobjatt + array set sobjatt [attlist $sobj] + switch $sobjatt(type) { + motor - configurablevirtualmotor { + if {[info exists sobjatt(group)]} { + set hpath [add_hpath $hpath $sobjatt(group)] + hsetprop $hpath type part + } + if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { +# hattach $hpath $sobj $sobjatt(long_name) +# hsetprop $hpath/$sobjatt(long_name) units $sobjatt(units) +# hsetprop $hpath/$sobjatt(long_name) long_name $sobjatt(long_name) + set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] + hsetprop $node_path savecmd $sobjatt(savecmd) + hsetprop $node_path sdsinfo $sobjatt(sdsinfo) + hsetprop $node_path nxalias $sobjatt(nxalias) + hsetprop $node_path mutable $sobjatt(mutable) + } else { + clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error + } + } + macro { + if {[info exists sobjatt(group)]} { + set hpath [add_hpath $hpath $sobjatt(group)] + hsetprop $hpath type part + } + if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} { + clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error + } else { + add_node $hpath kind $sobjatt(kind) node $sobj dtype $sobjatt(type) priv $sobjatt(privilege) + } + } + sicsvariable { + if {[info exists sobjatt(group)]} { + set hpath [add_hpath $hpath $sobjatt(group)] + hsetprop $hpath type part + } + if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { + set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] + hsetprop $node_path sicsdev $sobj + hsetprop $node_path nxalias $sobj + hsetprop $node_path savecmd $sobjatt(savecmd) + hsetprop $node_path sdsinfo $sobjatt(sdsinfo) + hsetprop $node_path mutable $sobjatt(mutable) + hsetprop $node_path privilege $sobjatt(privilege) + } else { + clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error + } + } + node { + } + singlecounter { +# TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } + histmem { +# TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + if {[info exists sobjatt(group)]} { + set hpath [add_hpath $hpath $sobjatt(group)] + hsetprop $hpath type part + } + if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { + set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] + hsetprop $node_path savecmd $sobjatt(savecmd) + hsetprop $node_path sdsinfo $sobjatt(sdsinfo) + hsetprop $node_path nxalias $sobjatt(nxalias) + hsetprop $node_path mutable $sobjatt(mutable) + hsetprop $node_path sicsdev $sobj + } else { + clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error + } + } + nxscript { +# TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } + sicsdata { +# TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } + scanobject { +# TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } + } +} + +# sobjtypeadd +# Traverses list of sics objects of given type and attaches the matching sics objects to the given hpath +# Hipadaba node properties are constructed from the sobj attribute list. +proc sobjtypeadd {hpath sobjtype given_klass} { + foreach {sobj} [sobjlist $sobjtype $given_klass] { + sobjadd $hpath $sobj + } +} + + +## \brief Remove empty instrument dictionary nodes +# +# \param instdict name of the instrument dictionary structure +# +# Nodes which have no child nodes and no associated sics objects for the +# current instrument are removed. +proc prune {instdict} { + upvar $instdict dict + array set dictarr $dict + set candidates [array names dictarr] + # While there are candidates for removal remove the childless ones + # which have an empty sobj list + while {[expr [llength $candidates]] > 0} { + set new_candidates "" + foreach name $candidates { + array unset dictval + array set dictval $dictarr($name) + if {[lsearch $dictval(property) nxvgroup] != -1} { + # Link targets are not candidates for pruning + continue + } + set sobjects "" + if {[info exists dictval(sobj)]} { + foreach {t k} $dictval(sobj) { + lappend sobjects [sobjlist $t $k] + } + } + if { [llength [join $sobjects]] == 0 } { + if {[llength [array get dictarr $name/*]] == 0} { + array unset dictarr $name + } else { + if {[lsearch $candidates $name/*] != -1} { + lappend new_candidates $name + } + } + } + } + set candidates $new_candidates + } + set dict [array get dictarr] + return +} +# +#TODO add data control nxsave nxtyp properties +##\brief Traverse the instrument dictionary and construct the hipadaba database. +# +# \param instDict name of the instrument dictionary structure +# +# This command prunes the dictionary before building it. +# \see prune +proc buildHDB {instDict} { +upvar #0 $instDict dictionary +prune dictionary + foreach {n v} $dictionary { + array unset varr + array set varr $v + array unset property_array + array set property_array $varr(property) + add_node / path $n prop_list $varr(property) + if {[info exists varr(sobj)]} { + foreach {sicstype sobj_klass} $varr(sobj) { + sobjtypeadd /$n $sicstype $sobj_klass + } + } + } +} + +namespace eval ::hdb { + proc set_save {hpath mode {top true}} { + if {$hpath != "/"} { + set hnode $hpath + } else { + foreach hp [hlist /] { + ::hdb::set_save /$hp $mode + } + return + } + if {[::utility::hgetplainprop $hnode data] == "false"} { + return + } + foreach hp [hlist $hnode] { + set_save $hnode/$hp $mode false + } + if {$top == "true"} { + hsetprop $hnode nxsave $mode + if {$mode == "true"} { + set hp "" + foreach ps [lrange [split [string trim $hnode /] /] 0 end-1] { + set hp $hp/$ps + hsetprop $hp nxsave true + } + } + } else { + hsetprop $hnode nxsave $mode + } + } +} diff --git a/site_ansto/instrument/config/hipadaba/instdict_specification.tcl b/site_ansto/instrument/config/hipadaba/instdict_specification.tcl new file mode 100644 index 00000000..8c4c8ece --- /dev/null +++ b/site_ansto/instrument/config/hipadaba/instdict_specification.tcl @@ -0,0 +1,130 @@ +# The attributes and values for sics objects and instrument dictionaries must comply +# with the following lists. + +set boolean {true false} +# INSTRUMENT DICTIONARIES MUST PROVIDE THE FOLLOWING INFORMATION +#set dict_property_list { +# data [subst {{$boolean}}] +# control [subst {{$boolean}}] +# nxsave [subst {{$boolean}}] +# nxtype [subst {{$nexus_classes}}] +#} + +# SICS OBJECTS MUST PROVIDE THE FOLLOWING INFORMATION +set sobj_klass_list {aperture attenuator collimator command crystal data detector experiment graphics monitor monochromator plc sample scan user} +set sobj_sicstype_list {sicsvariable macro motor configurablevirtualmotor singlecounter histmem nxscript sicsdata scanobject} +# Different kinds of things are added to the hdb in different ways. +# command: This is something a client can run with hset /a/b/c start, it may have parameters and feedback. +# Parameters and feedback should be made available in 'ilists' named after the command. +# ilist: An intelligent list, it's like a list comprehension that takes a closure as the mapping function. +# event: This is an associative array which can be watched for modifications. You can use the array index +# to choose an action. +# script: Supplies an rscript and a wscript to attach to a node for hgets and hsets. +# hobj: Something that can be hattached to a node. {motor sicsvariable histmem}. +set sobj_kind_list {command event hobj ilist script} +set sobj_interfacelist [subst {drivable {$boolean} countable {$boolean} callback {$boolean} environment {$boolean} }] + +set privilege_list {spy user manager read_only internal} +set sobj_privilege [subst {privilege {$privilege_list}}] + +# This is a subset of the list of attributes which the +# [sicslist ] command must return for the hdbbuilder +# The 'data' and 'control' attributes need to be part of the metadata for +# a sics object because you know how it could/should be used when you +# create it. +set sobj_attlist [subst { + $sobj_interfacelist + type [subst {{$sobj_sicstype_list}}] + klass [subst {{$sobj_klass_list}}] + long_name {text} + data [subst {{$boolean}}] + control [subst {{$boolean}}] + kind [subst {{$sobj_kind_list}}] + nxsave [subst {{$boolean}}] + $sobj_privilege +}] + +# OBJECT SPECIFIC ATTRIBUTES +set motor_attlist [subst { + $sobj_attlist + units alpha + savecmd {print} + nxalias {text} + mutable [subst {{$boolean}}] +}] + +set configurablevirtualmotor_attlist [subst { + $motor_attlist +}] + +set singlecounter_attlist [subst { + $sobj_attlist + mutable [subst {{$boolean}}] +}] + +set histmem_attlist [subst { + $sobj_attlist + mutable [subst {{$boolean}}] +}] + +set scanobject_attlist [subst { + $sobj_attlist +}] + +set sicsvariable_attlist [subst { + $sobj_attlist + mutable [subst {{$boolean}}] +}] + +# A macro can be attached to an hdb node as a command or a script +set macro_attlist [subst { + $sobj_attlist +}] + +set nxscript_attlist [subst { + $sobj_attlist +}] + +set sicsdata_attlist [subst { + $sobj_attlist + mutable [subst {{$boolean}}] +}] + +# INSTRUMENT DICTIONARIES MUST PROVIDE THE FOLLOWING INFORMATION +if 1 { + set nexus_classes { NXaperture NXattenuator NXbeam_stop NXbeam NXbending_magnet NXcharacterizations NXcollimator NXcrystal NXdata NXdetector NXdisk_chopper NXentry NXenvironment NXevent_data NXfermi_chopper NXfilter NXflipper NXgeometry NXguide NXinsertion_device NXinstrument NXlog NXmirror NXmoderator NXmonitor NXnote NXorientation NXpositioner NXprocess NXroot NXsample NXsensor NXshape NXsource NXtranslation NXuser NXvelocity_selector} + + set dict_privilege_list { + } +# datatype can include rank and dimensions +# @none is included to allow subtree nodes and leaves to be handled +# uniformly. + set dict_datatype_list { @none NX_CHAR NX_FLOAT32 NX_INT32 } + +# link = name of an nxalias + set dict_property_list [subst { + {data control nxsave} {$boolean} + klass {@none $nexus_classes} + type {commandset graphset instrument part nxvgroup} + nxalias text + link {@none text} + savecmd text + }] + + +# hpath looks like /a/b/c/ +set regex_hpath {^(/)$|^([_a-z0-9]+)(/[_a-z0-9]+)*$} +set instrument_dictionary [subst { + regex_hpath { + optional { + children {alpha alpha} + sobj {{@any $sobj_sicstype_list} {$sobj_klass_list}} + } + required { + privilege {$privilege_list} + datatype [subst {{$dict_datatype_list}}] + property [subst {{$dict_property_list}}] + } + } +}] +} diff --git a/site_ansto/instrument/config/hmm/anstohm_linked.xml b/site_ansto/instrument/config/hmm/anstohm_linked.xml new file mode 100644 index 00000000..2b3bc751 --- /dev/null +++ b/site_ansto/instrument/config/hmm/anstohm_linked.xml @@ -0,0 +1,22 @@ + + + + + + + + + + + + + [BAT_TABLE] + [CAT_TABLE] + [FAT_TABLE] + [NAT_TABLE] + [OAT_TABLE] + [SAT_TABLE] + [SRV_TABLE] + + + diff --git a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl index 33455ae9..ae3ba8ab 100644 --- a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl +++ b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.14 $ -# $Date: 2007-05-08 04:58:51 $ +# $Revision: 1.15 $ +# $Date: 2007-07-22 05:23:40 $ # Author: Mark Lesha (mle@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -10,25 +10,27 @@ #ffr MakeHM hmm anstohttp, move to inst specific config namespace eval histogram_memory { -VarMake hmm_dim0 Int User -VarMake hmm_dim1 Int User -VarMake hmm_dim2 Int User -VarMake hmm_histmode Text User -VarMake hmm_bank Int User -VarMake hmm_rank Int User -VarMake hmm_start Int User -VarMake hmm_length Int User -VarMake hmm_mode Text User -VarMake _hmm_vert_axis Text User -VarMake _hmm_hor_axis Text User -VarMake _hmm_hor_axis_alias Text User -VarMake _hmm_vert_axis_alias Text User -VarMake _hmm_hor_channel_name Text User -_hmm_vert_axis y_pixel_offset -_hmm_vert_axis_alias dvaxis -_hmm_hor_axis polar_angle -_hmm_hor_axis_alias dtheta -_hmm_hor_channel_name horizontal_channel_number + ::utility::mkVar hmm_user_configpath Text manager user_configpath false detector true false + hmm_user_configpath ../user_config/hmm + ::utility::mkVar hmm_dim0 Int user dim0 true detector true true + ::utility::mkVar hmm_dim1 Int user dim1 true detector true true + ::utility::mkVar hmm_dim2 Int user dim2 true detector true true + ::utility::mkVar hmm_histmode Text user histmode true detector true true + ::utility::mkVar hmm_bank Int user bank false detector true false + ::utility::mkVar hmm_rank Int user rank true detector true true + ::utility::mkVar hmm_start Int user start false detector true false + ::utility::mkVar hmm_length Int user length false detector false false + ::utility::mkVar hmm_mode Text user mode true detector true true + ::utility::mkVar _hmm_vert_axis Text user vert_axis true detector false true + ::utility::mkVar _hmm_hor_axis Text user hor_axis true detector false true + ::utility::mkVar _hmm_hor_axis_alias Text user hor_axis_alias true detector false true + ::utility::mkVar _hmm_vert_axis_alias Text user vert_axis_alias true detector false true + ::utility::mkVar _hmm_hor_channel_name Text user hor_channel_name true detector false true + _hmm_vert_axis y_pixel_offset + _hmm_vert_axis_alias dvaxis + _hmm_hor_axis polar_angle + _hmm_hor_axis_alias dtheta + _hmm_hor_channel_name horizontal_channel_number ############################################## # Creating the histogram memories in SICS ############################################## @@ -41,16 +43,16 @@ _hmm_hor_channel_name horizontal_channel_number ############################################## # Configuring the histogram server ############################################## - + # Procedure to read a single config (or any) file, return content as a string. -proc returnconfigfile {filename} { - set fh [open $filename] - set xml [read $fh] - #set xml [list [read $fh]] - clientput $xml value - close $fh - return $xml -} + proc returnconfigfile {filename} { + set fh [open $filename] + set xml [read $fh] +#set xml [list [read $fh]] + debug_msg $xml value + close $fh + return [subst $xml] + } # Initialize the histogram server. # This call to hmm init (with init 1 configured) causes the histogram server @@ -61,20 +63,20 @@ proc returnconfigfile {filename} { # during DAQ is not allowed. This requires init of the hmm object to level 0. # # Making sure the histogram server is stopped, so we can load configuration. -proc hmm_initialize {} { -hmm configure hmaddress http://das1-[SplitReply [instrument]]:8080 -hmm configure username spy -hmm configure password 007 -hmm configure hmDataPath ../HMData + proc hmm_initialize {} { + hmm configure hmaddress http://das1-[SplitReply [instrument]]:8080 + hmm configure username spy + hmm configure password 007 + hmm configure hmDataPath ../HMData -hmm configure init 0 -hmm init -hmm stop + hmm configure init 0 + hmm init + hmm stop # Load the configuration to the histogram server. -hmm configure init 1 -hmm init + hmm configure init 1 + hmm init # Restore the init level to 0, subesquent inits will only upload specified FAT settings to histogram server. -hmm configure init 0 + hmm configure init 0 ############################################## # Configuring the histogram memories in SICS @@ -83,35 +85,35 @@ hmm configure init 0 # Now issue stop to the server. # This not only makes sure it's stopped, but lets us see certain configuration variables # which get placed in the dictionary as part of the status checking done during the stop. -hmm stop -} + hmm stop + } # Here, define a function to let us read back the value of dictionary items from the hmm # such as OAT dimensions. -proc hmmdictitemval {histomem dictitem} { - set resp [$histomem configure $dictitem] - set retn [lindex [split $resp " "] 2] - return $retn -} + proc hmmdictitemval {histomem dictitem} { + set resp [$histomem configure $dictitem] + set retn [lindex [split $resp " "] 2] + return $retn + } # Configure histogram dimensions, mode, etc. using the dictionary variables. # For the dimensions, set the 'effective' OAT dimensions which are the # histogram period dimensions. Do an init after to cause memory to be allocated. -proc hmm_setup {mode bankNum rankNum nyc nxc ntc} { + proc hmm_setup {mode bankNum rankNum nyc nxc ntc} { hmm_histmode $mode - hmm_bank $bankNum - hmm_rank $rankNum - hmm configure histmode $mode - hmm configure bank $bankNum - hmm configure rank $rankNum - hmm_dim0 [hmmdictitemval hmm $nyc] - hmm_dim1 [hmmdictitemval hmm $nxc] - hmm_length [expr {[SplitReply [hmm_dim0]] * [SplitReply [hmm_dim1]]} ] - hmm_dim2 [hmmdictitemval hmm $ntc] - hmm configure dim0 [SplitReply [hmm_dim0]] - hmm configure dim1 [SplitReply [hmm_dim1]] - hmm configure dim2 [SplitReply [hmm_dim2]] - hmm init -} + hmm_bank $bankNum + hmm_rank $rankNum + hmm configure histmode $mode + hmm configure bank $bankNum + hmm configure rank $rankNum + hmm_dim0 [hmmdictitemval hmm $nyc] + hmm_dim1 [hmmdictitemval hmm $nxc] + hmm_length [expr {[SplitReply [hmm_dim0]] * [SplitReply [hmm_dim1]]} ] + hmm_dim2 [hmmdictitemval hmm $ntc] + hmm configure dim0 [SplitReply [hmm_dim0]] + hmm configure dim1 [SplitReply [hmm_dim1]] + hmm configure dim2 [SplitReply [hmm_dim2]] + hmm init + } ############################################## # Create beam monitor counter @@ -178,36 +180,36 @@ proc hmm_setup {mode bankNum rankNum nyc nxc ntc} { # # # Call is: scan2_runa -proc scan2_runa {n} { + proc scan2_runa {n} { # The termination condition is ignored, because the # histogram server controls the acquisition duration # directly in this case. - scan2 run $n timer 0 -} + scan2 run $n timer 0 + } # # Call is: scan2_runb -proc scan2_runb {n count_method count_size count_stop} { + proc scan2_runb {n count_method count_size count_stop} { # Commit the termination conditions to the histogram server. # hmm configure stores the values in the dictionary, # then hmm init causes them to be sent to the histogram server. # We just 'assume' they are successfully written. - hmm configure FAT_COUNT_METHOD $count_method - hmm configure FAT_COUNT_SIZE $count_size - hmm configure FAT_COUNT_STOP $count_stop - hmm init + hmm configure FAT_COUNT_METHOD $count_method + hmm configure FAT_COUNT_SIZE $count_size + hmm configure FAT_COUNT_STOP $count_stop + hmm init # The termination condition is ignored, because the # histogram server controls the acquisition duration # directly in this case. So, use 'timer 0' here. - scan2 run $n timer 0 -} + scan2 run $n timer 0 + } # Simulated counter. No error rate. Required for technical reasons... # This counter is used only to block execution till the bm count is actually reached, # for the scan example using hmc and bm objects to control the acquisition duration from SICS. -MakeCounter blockctr SIM -1.0 -blockctr SetExponent 0 -blockctr SetMode timer -blockctr SetPreset 0 + MakeCounter blockctr SIM -1.0 + blockctr SetExponent 0 + blockctr SetMode timer + blockctr SetPreset 0 # Later on we can add some motors to drive... #Motor som2 ASIM 0 100 -1.0 0.01 @@ -230,16 +232,16 @@ blockctr SetPreset 0 # in to an argument of set_oat_offset to provide progressively # increasing offset, producing an overlapped histogram. # -global oatoffset + global oatoffset # #Function to apply OAT offsets to the histogram server. -proc set_oat_offset {oatoff_x oatoff_y oatoff_t} { - hmm configure FAT_OFFSET_OAT_X $oatoff_x - hmm configure FAT_OFFSET_OAT_Y $oatoff_y - hmm configure FAT_OFFSET_OAT_T $oatoff_t - hmm init - return -} + proc set_oat_offset {oatoff_x oatoff_y oatoff_t} { + hmm configure FAT_OFFSET_OAT_X $oatoff_x + hmm configure FAT_OFFSET_OAT_Y $oatoff_y + hmm configure FAT_OFFSET_OAT_T $oatoff_t + hmm init + return + } ############################################## # Support for data acquisition @@ -247,17 +249,17 @@ proc set_oat_offset {oatoff_x oatoff_y oatoff_t} { # A simple procedure to read the histogram data through SICS # and dump the data to a numbered file. -proc savehistodata {histomem filename} { - set fh [open $filename "w"] + proc savehistodata {histomem filename} { + set fh [open $filename "w"] # To get the whole memory, we don't need to specify the start or end arguments. # But we need to specify the bank number, this sets the type of data to be read. # - set histodata [$histomem get [hmmdictitemval $histomem bank]] + set histodata [$histomem get [hmmdictitemval $histomem bank]] # clientput $histodata value - puts -nonewline $fh $histodata - close $fh - return -} + puts -nonewline $fh $histodata + close $fh + return + } ############################################## ############################################## @@ -269,54 +271,61 @@ proc savehistodata {histomem filename} { # We use it to pause the histogram server, in order to commence the DAQ. # This 'primes' the DAE also (i.e. device drivers reboot the hardware, # buffering processes are started, etc.) -proc prepare {} { + proc prepare {} { #clientput "Enter prepare" value # # Before configuring the bm, do a short count. # This will cause the counter to reconnect if it needs to... - bm count 0 timer + bm count 0 timer # Now configure the beam monitor counter for better performance. # (Set a high counter sample rate to get better accuracy). - bm send set scan=1 - bm send set sample=1000 + bm send set scan=1 + bm send set sample=1000 # Make sure the histogram server is stopped, this guarantees DAQ not in progress already. - hmm stop + hmm stop # Zero the OAT offsets (whether used or not). - global oatoffset - set oatoffset 0 - set_oat_offset 0 0 0 + global oatoffset + set oatoffset 0 + set_oat_offset 0 0 0 # # stdscan prepare $scanobjectname $userobjectname #clientput "hmm pause being done..." value # Pause the histogram server, this primes the DAE for acqisition. - hmm pause + hmm pause #clientput "Exit prepare" value - return -} + return + } # The count_bm_controlled callback gets called at the start of dataset acquisition. # We use it to perform the dataset acquisition, via the hmc object. # Note we do NOT call stdscan count, since we don't need to run the bm counter twice. -proc count_bm_controlled {mode preset} { + proc count_bm_controlled {mode preset} { + ::histogram_memory::count -set feedback status BUSY #clientput "Enter count" value #stdscan count $scanobjectname $userobjectname $point $mode $preset # Start the acquisition, runs till the beam monitor terminates # and then enter paused mode (we have added fifth argument to allow this). # In fact, execution proceeds immediately (the hmc call doesn't block). - hmc start $preset $mode pause + hmc start $preset $mode pause # Now call the simulated counter. This will cause execution to block # till the hmc acquisition actually finishes. Otherwise, execution will # charge on regardless and the finish callback function gets called # before the last dataset acquisition has finished! - blockctr count 0 + blockctr count 0 #clientput "Exit count" value - return -} + ::histogram_memory::count -set feedback status IDLE + array set param [::data::gumtree_save -list param] + data axis 1 $param(run_number) + data data_set hmm + ::hdb::set_save /instrument/detector true + ::hdb::set_save /data true + return + } # The count_hs_controlled callback gets called at the start of dataset acquisition. # We use it to perform the dataset acquisition, controlled by the histogram server. # Note we do NOT call stdscan count, since we don't need to run the bm counter twice. -proc hs_count_hs_controlled {scanobjectname userobjectname point mode preset} { + proc hs_count_hs_controlled {scanobjectname userobjectname point mode preset} { #clientput "Enter count" value #stdscan count $scanobjectname $userobjectname $point $mode $preset # Start the acquisition, runs till the histogram server auto-terminates. @@ -325,15 +334,15 @@ proc hs_count_hs_controlled {scanobjectname userobjectname point mode preset} { # The termination condition for the bm counter is just set to a large time period. # After the acquisition terminates, the beam monitor therefore has the correct # status reading and the 'Monitor' entry in the scan data table will be correct. - hmc start 1000000000 timer pause 1 + hmc start 1000000000 timer pause 1 # Now call the simulated counter. This will cause execution to block # till the hmc acquisition actually finishes. Otherwise, execution will # charge on regardless and the finish callback function gets called # before the last dataset acquisition has finished! - blockctr count 0 + blockctr count 0 #clientput "Exit count" value - return -} + return + } # The collect callback gets called at the end of the dataset acquisition. # We can put stuff here to retrieve data collected at each scan point, @@ -347,13 +356,13 @@ proc hs_count_hs_controlled {scanobjectname userobjectname point mode preset} { # Code for adjusting ancillaries, moving secondary motion stages etc. etc. # from point to point should probably be put into a drive callback function # (but not in this example script). -proc hs_collect {scanobjectname userobjectname point} { + proc hs_collect {scanobjectname userobjectname point} { #clientput "Enter collect" value - set rslt [stdscan collect $scanobjectname $userobjectname $point] + set rslt [stdscan collect $scanobjectname $userobjectname $point] # Apply an OAT offset in the x direction (e.g. along tube number axis). - global oatoffset - incr oatoffset - set_oat_offset $oatoffset 0 0 + global oatoffset + incr oatoffset + set_oat_offset $oatoffset 0 0 # Checking the beam monitor #clientput [bm send read] value # At each scan point, read the total x-y histogram @@ -361,18 +370,18 @@ proc hs_collect {scanobjectname userobjectname point} { # each dataset (when restarting from paused state), # so it represents the hstogram acquired per scan point. #clientput "Exit collect" value - return -} + return + } # The finish callback gets called at the end of the scan. # We use it to stop the histogram server, terminating the dataset. -proc finish {} { + proc finish {} { #clientput "Enter finish" value # stdscan finish $scanobjectname $userobjectname #clientput "hmm stop being done..." value - hmm stop + hmm stop # Just in case someone expects zero OAT offsets later on ;) - set_oat_offset 0 0 0 + set_oat_offset 0 0 0 # Get and write the data from the main histogram to disk (filename "HistoData"). # Sicne this is the first (and only) access to hmm data, it is retrieved from # the server and we don't need to do hmm init first to force update hmm memory. @@ -380,14 +389,14 @@ proc finish {} { # savehistodata hmm "../data/HistoData" # #clientput "Exit finish" value - return -} + return + } -proc count_withbm {mode preset} { - prepare; - count_bm_controlled $mode $preset; - finish; -} + proc count_withbm {mode preset} { + prepare; + count_bm_controlled $mode $preset; + finish; + } proc init {} { } @@ -401,17 +410,17 @@ proc count_withbm {mode preset} { } proc save {point } { - #TODO maybe add nxobj and point parameters. - set hor_axis [SplitReply [_hmm_hor_axis]] - set vert_axis [SplitReply [_hmm_vert_axis]] +#TODO maybe add nxobj and point parameters. + set hor_axis [SplitReply [_hmm_hor_axis]] + set vert_axis [SplitReply [_hmm_vert_axis]] # set point 0 - if {$point == 0} { - nxcreatefile nexus_hmscan.dic; - } else { - nxreopenfile - } + if {$point == 0} { + nxcreatefile nexus_hmscan.dic; + } else { + nxreopenfile + } nxscript putattribute program_name run_mode hmmcount - hmm_save nxscript entry1 $point; + hmm_save nxscript entry1 $point; nxscript_data clear; nxscript_data putint 0 $point; nxscript putslab erun [list $point] [list 1] nxscript_data; @@ -421,16 +430,150 @@ proc count_withbm {mode preset} { nxscript putattribute hmcounts axes run_number:$vert_axis:$hor_axis; nxclosefile; } + proc set_sobj_attributes {} { +# set_sicsobj_atts sobj klass group name control data +if 0 { + set_sicsobj_atts hmm_user_configpath detector hmm user_configpath true false; + set_sicsobj_atts hmm_dim0 detector hmm dim0 true true; + set_sicsobj_atts hmm_dim1 detector hmm dim1 true true; + set_sicsobj_atts hmm_dim2 detector hmm dim2 true true; + set_sicsobj_atts hmm_histmode detector hmm histmode true true; + set_sicsobj_atts hmm_bank detector hmm bank true false; + set_sicsobj_atts hmm_rank detector hmm rank true true; + set_sicsobj_atts hmm_start detector hmm start true false; + set_sicsobj_atts hmm_length detector hmm length false false; + set_sicsobj_atts hmm_mode detector hmm mode true true; + set_sicsobj_atts _hmm_vert_axis detector hmm vert_axis false true; + set_sicsobj_atts _hmm_hor_axis detector hmm hor_axis false true; + set_sicsobj_atts _hmm_hor_axis_alias detector hmm hor_axis_alias false true; + set_sicsobj_atts _hmm_vert_axis_alias detector hmm vert_axis_alias false true; + set_sicsobj_atts _hmm_hor_channel_name detector hmm hor_channel_name false true; } -publish ::histogram_memory::finish user -#publish ::histogram_memory::hs_collect user -publish ::histogram_memory::hs_count_hs_controlled user -publish ::histogram_memory::count_bm_controlled user -publish ::histogram_memory::prepare user -publish ::histogram_memory::set_oat_offset user -publish ::histogram_memory::scan2_runb user -publish ::histogram_memory::scan2_runa user -publish ::histogram_memory::returnconfigfile user -publish ::histogram_memory::count_withbm user -publish ::histogram_memory::save user + # SICS commands + sicslist setatt blockctr privilege internal; + + # histogram memory macros + sicslist setatt ::histogram_memory::finish privilege internal; + sicslist setatt ::histogram_memory::hs_count_hs_controlled privilege internal; + sicslist setatt ::histogram_memory::count_bm_controlled privilege internal; + sicslist setatt ::histogram_memory::prepare privilege internal; + sicslist setatt ::histogram_memory::set_oat_offset privilege internal; + sicslist setatt ::histogram_memory::scan2_runb privilege internal; + sicslist setatt ::histogram_memory::scan2_runa privilege internal; + sicslist setatt ::histogram_memory::returnconfigfile privilege internal; + sicslist setatt ::histogram_memory::count_withbm privilege internal; + sicslist setatt ::histogram_memory::save privilege internal; + + set_sicsobj_atts hmm detector @none hmm_data true true; + sicslist setatt hmm privilege user + sicslist setatt hmm kind hobj + sicslist setatt hmm nxsave true + } +} + +proc BAT_TABLE {args} {} +proc CAT_TABLE {args} {} +set hmm_xml(FAT_TABLE) "" +proc FAT_TABLE {args} { + global hmm_xml + if {$args == ""} {return $hmm_xml(FAT_TABLE)} + array set param [string toupper $args] + set hmm_xml(FAT_TABLE) "" +} +proc NAT_TABLE {args} {} +set hmm_xml(OAT_TABLE) "" +proc OAT_TABLE {args} { + global hmm_xml + if {$args == ""} {return $hmm_xml(OAT_TABLE)} + array set param $args + set X_min -210; set X_max 210 + set Y_min -110; set Y_max 110 + set NOXCH [SplitReply [hmm configure dim0]] + set NOYCH [SplitReply [hmm configure dim1]] + set NOTCH [SplitReply [hmm configure dim2]] + foreach tag {XTAG YTAG TTAG} {set $tag ""} + set hmm_xml(OAT_TABLE) { + + $XTAG + $YTAG + $TTAG + +} + if {[info exists param(NTC)]} { + set NOTCH $param(NTC) + } + foreach coord {X Y T} { + if {[info exists param($coord)]} { + set ${coord}TAG "<$coord>$param($coord)" + set bbnum [llength $param($coord)] + if {$bbnum > 2} { + set NO${coord}CH [expr $bbnum - 1] + } else { + if {$coord != "T"} { + set b0 [lindex $param($coord) 0] + set b1 [lindex $param($coord) 1] + set NO${coord}CH [expr {1+([set ${coord}_max] - [set ${coord}_min])/($b1 - $b0)}] + } + } + } + } + FAT_TABLE SIZE_PERIOD [expr {$NOXCH*$NOYCH*$NOTCH}] + set hmm_xml(OAT_TABLE) [subst $hmm_xml(OAT_TABLE)] + return $hmm_xml(OAT_TABLE) +} +proc SAT_TABLE {args} {} +proc SRV_TABLE {args} {} + +proc inst_defaults {} { + global ::histogram_memory::hmm_def_filename + return $::histogram_memory::hmm_def_filename +} +proc dae_type {} { + global ::histogram_memory::hmm_dae_type + return $::histogram_memory::hmm_dae_type +} +proc ::histogram_memory::configure_server {instdef dtype} { + variable hmm_def_filename + variable hmm_dae_type + set hmm_def_filename $instdef + set hmm_dae_type $dtype + set configuration "::histogram_memory::returnconfigfile config/hmm/anstohm_linked.xml" + debug_msg $configuration + hmm configure hmconfigscript $configuration + ::histogram_memory::hmm_initialize +} +Publish ::histogram_memory::finish user +#Publish ::histogram_memory::hs_collect user +Publish ::histogram_memory::hs_count_hs_controlled user +Publish ::histogram_memory::count_bm_controlled user +Publish ::histogram_memory::prepare user +Publish ::histogram_memory::set_oat_offset user +Publish ::histogram_memory::scan2_runb user +Publish ::histogram_memory::scan2_runa user +Publish ::histogram_memory::returnconfigfile user +Publish ::histogram_memory::count_withbm user +Publish ::histogram_memory::save user +Publish BAT_TABLE user +Publish CAT_TABLE user +Publish FAT_TABLE user +Publish NAT_TABLE user +Publish OAT_TABLE user +Publish SAT_TABLE user +Publish SRV_TABLE user + +namespace eval ::histogram_memory { + command count {text:monitor,timer mode float: preset} { + ::histogram_memory::prepare + ::histogram_memory::count_bm_controlled $mode $preset; + ::histogram_memory::finish + } + ::histogram_memory::count -addfb text status + ::histogram_memory::count -set feedback status IDLE +} diff --git a/site_ansto/instrument/config/nexus/nexus_in_hmm_common_1.dic b/site_ansto/instrument/config/nexus/nexus_in_hmm_common_1.dic index 0adf411c..fd457eef 100644 --- a/site_ansto/instrument/config/nexus/nexus_in_hmm_common_1.dic +++ b/site_ansto/instrument/config/nexus/nexus_in_hmm_common_1.dic @@ -6,7 +6,7 @@ dradius=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS ra dheight=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS height -type NX_FLOAT32 -attr {units,mm} detangle_rad=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS arc -type NX_FLOAT32 -attr {units,radians} detangle_degrees=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS arc -type NX_FLOAT32 -attr {units,degrees} -dtheta=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS polar_angle -type NX_FLOAT32 -LZW -rank 2 -dim {-1,$(padim1)} -attr {units,degrees} +dtheta=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS two_theta -type NX_FLOAT32 -LZW -rank 2 -dim {-1,$(padim1)} -attr {units,degrees} dvaxis=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS y_pixel_offset -type NX_FLOAT32 -LZW -rank 1 -dim {$(padim0)} -attr {units,mm} dhaxis=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS x_pixel_offset -type NX_FLOAT32 -LZW -rank 1 -dim {$(padim1)} -attr {units,mm} drowindex=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS $(row_index_name) -type NX_INT32 -LZW -rank 1 -dim {$(padim0)} diff --git a/site_ansto/instrument/config/nexus/nexus_in_scan_common_1.dic b/site_ansto/instrument/config/nexus/nexus_in_scan_common_1.dic index d3a3ec02..5ab314bc 100644 --- a/site_ansto/instrument/config/nexus/nexus_in_scan_common_1.dic +++ b/site_ansto/instrument/config/nexus/nexus_in_scan_common_1.dic @@ -9,6 +9,7 @@ scandata=/$(entryName),NXentry/data,NXdata/NXVGROUP scanhoraxis=/$(entryName),NXentry/data,NXdata/NXVGROUP scanvertaxis=/$(entryName),NXentry/data,NXdata/NXVGROUP scanvar=/$(entryName),NXentry/data,NXdata/NXVGROUP +scantwotheta=/$(entryName),NXentry/scan_step,NXdata/SDS two_theta -type NX_FLOAT32 -attr {units,degree} -attr {long_name,two_theta} scanstep=/$(entryName),NXentry/scan_step,NXdata/SDS value -type NX_FLOAT32 -attr {units,degree} -attr {long_name,stepsize} #histogram=/$(entryName),NXentry/histogram,NXdata/NXVGROUP #scanvar=/$(entryName),NXentry/$(scan_variable),NXdata/NXVGROUP diff --git a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl index c43338dc..8e4ed0e0 100644 --- a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl +++ b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl @@ -1,3 +1,427 @@ +## TODO Put all the nexus macros in the nexus namespace +MakeNXScript +sicsdatafactory new nxscript_data +namespace eval nexus { + variable nxdictionary + + set exports [list newfile closefile save data] + eval namespace export $exports + datafilename + proc createfile {} { + global cfPath + variable nexusdic + variable state + variable nxFileOpen; + set nxdict_path $cfPath(nexus)/$nexusdic + set file_type [SplitReply [SicsDataSuffix]] + array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]; + dataFileName [newFileName $file_type] + ::nexus::gen_nxdict $nexusdic + nxscript $nxmode($file_type) [SplitReply [dataFileName]] $nxdict_path; + set nxFileOpen true + set state(file,status) open + } + + ## \brief Sets 'new file' state to true + proc newfile {{type deflt } {nxdic nexus.dic}} { + variable nexusdic + variable state + if {$type == "deflt"} { + set type [SplitReply [SicsDataSuffix]] + } + set state(file,new) true + set nexusdic $nxdic + } +# Don't overwrite data from a previous SICS session + newfile + + proc save_data {point} { + ::nexus::nxreopenfile + foreach child [hlist /] { + if {[::utility::hgetplainprop /experiment data] == "true"} { + ::nexus::savetree $child $point + } + } + ::nexus::nxclosefile + } + ## \brief save data collected by last data acquisition command. + # + # \param point experimental point number, this is the array index for mutable + # datasets in the nexus file. Optional, default = 0 + # + # The save command will create a new file if the newfile state is set to true, or + # if the datatype property != the currentfiletype property of the /data hdb node. + proc save {{point 0}} { + variable state + ::data::gumtree_save -set run_number $point + if {$state(file,new) == "true"} { + createfile + save_data $point + linkdata + hsetprop /data currentfiletype [::utility::hgetplainprop /data datatype] + set state(file,new) false + } else { + if {[::utility::hgetplainprop /data currentfiletype] != [::utility::hgetplainprop /data datatype]} { + createfile + save_data $point + linkdata + hsetprop /data currentfiletype [::utility::hgetplainprop /data datatype] + set state(file,new) false + } + save_data $point + } + } + +## \brief Reopen the current file. +proc nxreopenfile {} { + global cfPath + variable nxFileOpen + variable nexusdic + if {$nxFileOpen == "false"} { + nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic; + set nxFileOpen true; + } +} + +## \brief Close the current file. You can reopen it with nxreopenfile +# +# \see nxreopenfile +proc nxclosefile {} { + variable nxFileOpen; + if {$nxFileOpen == "true"} { + nxscript close; + set nxFileOpen false; + set flist [split [SplitReply [dataFileName]] "/"]; + set fname [lindex $flist [expr [llength $flist] - 1] ]; + clientput "$fname updated" "event"; + } +} +## \brief Records that a given data source should be linked to nexus data target. +# +# NOTE: If a link has already been recorded then it does nothing. This allows you to +# override default links set by a command. eg A "count" command may link axis_1 to +# the run number but a "scan" command which uses the count command can link axis_1 to +# a scan variable. +# +# Usage: +# data data_set datsource +# Records that /data/data_set should be linked to datsource and sets a data type identifier +# data axis 1|2|3|4 datsource +# Records that /data/axisn should be linked to datsource +# data clear +# Clears all link targets and sets the data type identifier to unknown +proc data {args} { + set dpath /data + set opt [lindex $args 0] + switch $opt { + "axis" { + set axnum [lindex $args 1] + if {[string is integer $axnum] == 0} { + error "ERROR: [info level -1]->data, index for data axis should be an integer, not $axnum" + } + set hp $dpath/axis_$axnum + if {[::utility::hgetplainprop $hp link] == "@none"} { + hsetprop $hp link [lindex $args 2] + hsetprop $hp long_name [getatt [lindex $args 2] long_name] + } + } + "data_set" { + hsetprop $dpath datatype [lindex [info level -1] 0] + set hp $dpath/data_set + if {[::utility::hgetplainprop $hp link] == "@none"} { + hsetprop $hp link [lindex $args 1] + hsetprop $hp long_name [getatt [lindex $args 1] long_name] + } + } + "clear" { + foreach child [hlist $dpath] { + hsetprop $dpath/$child link @none + hsetprop $dpath/$child long_name @none + } + } + default {error "ERROR: [info level -1]->data, Unsupported option $opt"} + } +} + # Internal commands + # All experimental data of interest is linked under the data group + proc linkdata {} { + array unset axes + set hpath /data + ::nexus::nxreopenfile + foreach child [hlist $hpath] { + array set p_arr [::utility::hlistplainprop $hpath/$child] + if {$p_arr(data) == true && $p_arr(nxsave) == true} { + if {[info exists p_arr(nxalias)]} { + if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { + if {$p_arr(link) != "@none"} { + nxscript makelink $p_arr(nxalias) $p_arr(link) + switch -glob $child { + "axis_*" { + set n [lindex [split $child _] 1] + set axes($n) [::utility::hgetplainprop $hpath/$child long_name] + nxscript putattribute $p_arr(link) axis $n + } + "data_set" { + nxscript putattribute $p_arr(link) signal 1 + set data_set_alias $p_arr(link) + } + default {error "ERROR: [info level -1]->linkdata, Unsupported data path $hpath/$child"} + } + } + } + } + } + } + if {[info exists axes]} { + foreach n [lsort [array names axes]] { + nxscript putattribute $data_set_alias axes [set axes($n)] + } + } + ::nexus::nxclosefile + ::nexus::data clear + } + + proc savetree {hpath {pt 0}} { + foreach child [hlist /$hpath] { + array unset p_arr + array set p_arr [::utility::hlistplainprop /$hpath/$child] + if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { + return + } + set data_type [lindex [split [hinfo /$hpath/$child] , ] 0] + if {$p_arr(data) == true && $p_arr(nxsave) == true } { + if {[info exists p_arr(savecmd)] && [info exists p_arr(nxalias)] } { + if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true" } { + $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type point $pt + } else { + $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type + } + } elseif {[info exists p_arr(savecmd)] || [info exists p_arr(nxalias)]} { + error_msg "/$hpath/$child must have both 'savecmd' and 'nxalias' properties\nThe actual property list for /$hpath/$child is [array get p_arr]" + } + ::nexus::savetree $hpath/$child $pt + } + } + } + + + # Where do we get the SDS info from for tcl variables? + proc save_scalar {args} { + todo_msg "Save floats ints, use this for local variables, events and sicsvariable data" + # use putfloat $event(...) or uset putslab + } + proc save_sicsvar {svar nxarg args} { + todo_msg "Use this to save tcl arrays, good for beam monitor count arrays" + } + + + proc _gen_nxdict {hpath dict_path name nxc} { + variable nxdictionary + if {[::utility::hgetplainprop /$hpath data] == "false"} { + debug_msg "$hpath doesn't have a data property" + return + } + foreach child [hlist /$hpath] { + if {[::utility::hgetplainprop /$hpath/$child data] == true} { + set nxclass [::utility::hgetplainprop /$hpath/$child klass] + if {[string range $nxc 0 1] == "NX"} { + ::nexus::_gen_nxdict $hpath/$child $dict_path/$name,$nxc $child $nxclass + } else { + # else construct SDS name by replacing '/' with '_' in path + ::nexus::_gen_nxdict $hpath/$child $dict_path ${name}_$child $nxclass + } + } + } + array set p_arr [::utility::hlistplainprop /$hpath] + set data_type [lindex [split [hinfo /$hpath] , ] 0] + if {$p_arr(data) == "true" && $p_arr(nxsave) == "true" && [info exists p_arr(nxalias)]} { + set alias $p_arr(nxalias) + if {[info exists p_arr(sdsinfo)]} { + if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true"} { + set nxdictionary($alias) "$dict_path/SDS $name [$p_arr(sdsinfo) $p_arr(sicsdev) $data_type mutable true]" + } else { + set nxdictionary($alias) "$dict_path/SDS $name [$p_arr(sdsinfo) $p_arr(sicsdev) $data_type mutable false]" + } + } elseif {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { + set nxdictionary($alias) "$dict_path/NXVGROUP" + } + } + } + proc gen_nxdict {nexusdic} { + global cfPath + variable nxdictionary + set nxdict_path $cfPath(nexus)/$nexusdic + array unset nxdictionary + foreach hp [hlist /] { + if {[::utility::hgetplainprop /$hp data] == true} { + set nxclass [::utility::hgetplainprop /$hp klass] + ::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass + } + } + set fh [open $nxdict_path w] + puts $fh "##NXDICT-1.0" + puts $fh padim0=0 + puts $fh padim1=0 + puts $fh padim2=0 + foreach {n v} [array get nxdictionary] { + puts $fh "$n = $v" + } + close $fh + } + proc show_nxdict {} { + variable nxdictionary + clientput [array get nxdictionary] + } + + proc set_sobj_attributes {} { + # SICS commands + sicslist setatt nxscript privilege internal; + # SICS data objects + sicslist setatt nxscript_data privilege internal; + + # nexus macros + sicslist setatt nxcreatefile privilege internal; + sicslist setatt addnxscanentry privilege internal; + sicslist setatt bm_addnxscanentry privilege internal; + + # Set savecmd on SICS objects + foreach sobj [lrange [sicslist type motor] 1 end] { + sicslist setatt $sobj savecmd ::nexus::motor::save + sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo + } + foreach sobj [sicslist type configurablevirtualmotor] { + sicslist setatt $sobj savecmd ::nexus::motor::save + sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo + } + foreach sobj [sicslist type histmem] { + sicslist setatt $sobj savecmd ::nexus::histmem::save + sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo + } + foreach sobj [sicslist type sicsvariable] { + sicslist setatt $sobj savecmd ::nexus::sicsvariable::save + sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo + } + foreach sobj [sicslist type singlecounter] { + sicslist setatt $sobj savecmd ::nexus::singlecounter::save + sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo + } + } +} +namespace import ::nexus::* +foreach expt $::nexus::exports { + publish $expt user + sicslist setatt $expt privilege internal +} + +namespace eval ::nexus::histmem { + proc save {hm nxalias data_type args} { + set dim0 [SplitReply [$hm configure dim0]] + set dim1 [SplitReply [$hm configure dim1]] + set dim2 [SplitReply [$hm configure dim2]] + nxscript updatedictvar padim0 $dim0 + nxscript updatedictvar padim1 $dim1 + nxscript updatedictvar padim2 $dim2 + set data_start 0 + set datalen [expr {$dim0 * $dim1 * $dim2}] + set bank 0 + if {[lindex $args 0] == "point"} { + set index [lindex $args 1] + nxscript putslab $nxalias [list $index 0 0 0] [list 1 $dim0 $dim1 $dim2] $hm $data_start $datalen $bank + } else { + } + } + proc sdsinfo {hm data_type args} { + array set param $args + array set hm_prop [attlist $hm] + if {$param(mutable) == true} { + return " -type NX_INT32 -LZW -rank 4 -dim {-1,\$(padim0),\$(padim1),\$(padim2)}" + } else { + return " -type NX_INT32 -LZW -rank 3 -dim {\$(padim0),\$(padim1),\$(padim2)}" + } + } +} + +namespace eval ::nexus::motor { + # The save commands are called with the sobj name and nxalias + # The sdsinfo commands provide the SDS description for an nxdic + + # save sphi alias float [point n] + proc save {motor nxalias data_type args} { + if {[lindex $args 0] == "point"} { + set index [lindex $args 1] + nxscript_data clear; + nxscript_data putfloat 0 [getVal [$motor] ] + nxscript putslab $nxalias [list $index] [list 1] nxscript_data + } else { + if {[getatt $motor type] == "motor"} { + nxscript putmot $nxalias $motor + } else { + nxscript putfloat $nxalias [SplitReply [$motor]] + } + } + } + proc sdsinfo {motor data_type args} { + array set param $args + array set mot_prop [attlist $motor] + set dtype [::nexus::hdb2nx_type $data_type] + if {$param(mutable) == true} { + return " -type $dtype -rank 1 -dim {-1} -attr {units,$mot_prop(units)} -attr {long_name,$mot_prop(long_name)}" + } else { + return " -type $dtype -attr {units,$mot_prop(units)} -attr {long_name,$mot_prop(long_name)}" + } + } +} + +namespace eval ::nexus { + proc hdb2nx_type {dtype} { + switch $dtype { + int {return NX_INT32} + float {return NX_FLOAT32} + text {return NX_CHAR} + default {error "ERROR: [info level -1]->hdb2nx_type, Unknown type $dtype"} + } + } +} + +namespace eval ::nexus::sicsvariable { + proc save {svar nxalias data_type args} { + set val [SplitReply [$svar]] + if {[lindex $args 0] == "point"} { + set index [lindex $args 1] + nxscript_data clear; + switch $data_type { + int {nxscript_data putint 0 $val} + float {nxscript_data putfloat 0 $val} + default {error "ERROR: [info level -1]->::nexus::sicsvariable::save, unknown type $data_type"} + } + nxscript putslab $nxalias [list $index] [list 1] nxscript_data + } else { + switch $data_type { + int {nxscript putint $nxalias $val} + float {nxscript putfloat $nxalias $val} + text {nxscript puttext $nxalias $val} + default {error "ERROR: [info level -1]->::nexus::sicsvariable::save, unknown type $data_type"} + } + } + } + proc sdsinfo {svar data_type args} { + array set param $args + set dtype [::nexus::hdb2nx_type $data_type] + if {$param(mutable) == true} { + return " -type $dtype -rank 1 -dim {-1}" + } else { + return " -type $dtype" + } + } +} +namespace eval ::nexus::singlecounter { + proc save {counter nxalias data_type args} { + todo_msg "Save counter: $counter" + } + proc sdsinfo {counter data_type args} { + todo_msg "Get sdsinfo for counter: $counter" + } +} # TODO Return filename from nxcreatefile and call nxreopen nxclose etc # TODO Make an nxscript namespace for all this. @@ -9,57 +433,38 @@ set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}] set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]] -set tmpstr [string map {"$" ""} {$Revision: 1.24 $}] +set tmpstr [string map {"$" ""} {$Revision: 1.25 $}] set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]] -MakeNXScript -sicsdatafactory new nxscript_data proc getVal {msg} { return [string trim [lindex [split $msg =] 1 ] ] } -proc newFileName {} { +proc newFileName {postfix} { +array set inst_mnem {quokka QKK womba WBT echidna ECH kowari KWR koala KOL taipan TPN platypus PLP pelican PLN} + sicsdatanumber incr; set idNum [SplitReply [sicsdatanumber]]; set dataPath [SplitReply [sicsdatapath]]; set prefix [SplitReply [sicsdataprefix]]; - set postfix [SplitReply [sicsdatapostfix]]; set date_time_arr [split [sicstime] " "] set isodate [lindex $date_time_arr 0]; set isotime [string map {: -} [lindex $date_time_arr 1]]; - return [format "%s/%s_%sT%s_%05d%s" $dataPath $prefix $isodate $isotime $idNum $postfix]; + return [format "%s/%s%07d.%s" $dataPath $inst_mnem([instname]) $idNum $postfix] } proc nxcreatefile {nxdic {type nx.hdf}} { global nxFileOpen cfPath nexusdic; - SicsDataPostFix .$type; set nexusdic $nxdic array set nxmode [list nx.hdf create5 h5 create5 nx5 create5 xml createxml]; - dataFileName [newFileName] + dataFileName [newFileName $type] nxscript $nxmode($type) [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic; set nxFileOpen true } -proc nxreopenfile {} { - global nxFileOpen cfPath nexusdic; - nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic; - set nxFileOpen true; -} - -proc nxclosefile {} { - global nxFileOpen; - if {$nxFileOpen == true} { - nxscript close; - set nxFileOpen false; - set flist [split [SplitReply [dataFileName]] "/"]; - set fname [lindex $flist [expr [llength $flist] - 1] ]; - clientput "$fname updated" "event"; - } -} - set dradius 1.25 set ndect 128 set tubedia 0.0254 @@ -295,7 +700,21 @@ proc putslitmotors {nxobj point} { } } -publish nxcreatefile user -publish addnxscanentry user -publish bm_addnxscanentry user +namespace eval data { + command gumtree_save {int: run_number} { + save $run_number + } + sicslist setatt ::data::gumtree_save long_name save + array set param [::data::gumtree_save -list param] + ::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false + command gumtree_type {text:nx.hdf,xml type} { + SicsDataSuffix $type + } + sicslist set ::data::gumtree_type long_name file_type + ::data::gumtree_type -set type [SplitReply [SicsDataSuffix]] +} + +Publish nxcreatefile user +Publish addnxscanentry user +Publish bm_addnxscanentry user diff --git a/site_ansto/instrument/config/scan/scan_common_1.tcl b/site_ansto/instrument/config/scan/scan_common_1.tcl index 40522f62..7cd74042 100644 --- a/site_ansto/instrument/config/scan/scan_common_1.tcl +++ b/site_ansto/instrument/config/scan/scan_common_1.tcl @@ -1,10 +1,10 @@ #TODO Define bmon and hmm scan commands in separate namespaces - MakeScanCommand hmscan bm $cfPath(scan)/scan_common_1.hdd recover.bin MakeScanCommand bmonscan bm $cfPath(scan)/scan_common_1.hdd recover.bin MakeScanCommand scan2 bm $cfPath(scan)/scan_common_1.hdd recover.bin -namespace eval scancommand { +namespace eval scan { + variable event; # List of counts variable bmoncounts_array variable bmoncounts_axis @@ -13,87 +13,60 @@ variable bmonscanvar_axis_hpath # hpath to values from bmoncounts_array # we use this to get auto-notification on update of bmonscancounts_array_hpath variable bmonscancounts_array_hpath - -# bmonscan setup parameters and feedback variables. -VarMake bmonscan_var_name Text User -VarMake bmonscan_var_value Float User -VarMake bmonscan_var_start Float User -VarMake bmonscan_var_step Float User -VarMake bmonscan_mode Text User -VarMake bmonscan_preset Float User -VarMake bmonscan_np_target Int User -VarMake bmonscan_point_current Int User -VarMake bmonscan_counts Int User -VarMake bmonscan_numchannels Int User -VarMake bmonscan_channel Int User - -# bmonscan graphdata variables. -VarMake bmonscan_np_graphics_target Int User -VarMake bmonscan_point_graphics_current Int User -VarMake bmonscan_var_graphics_value Float User - -VarMake hmscan_var_name Text User -VarMake hmscan_var_value Float User -VarMake hmscan_var_start Float User -VarMake hmscan_var_step Float User -VarMake hmscan_mode Text User -VarMake hmscan_preset Float User -VarMake hmscan_np_target Int User -VarMake hmscan_point_current Int User -VarMake hmscan_numchannels Int User -VarMake hmscan_channel Int User - variable scanVariable scan_var scanVarStart 0 scanVarStep 1 proc scan_collect {sobj uobj point} { } proc hmm_scan_prepare {sobj uobj} { - variable scanVarStart; - variable scanVarStep; - variable scanVariable; variable scan_pt_start_time + set nexusdic hmscan.dic - nxcreatefile nexus_hmscan.dic; - nxclosefile; # stdscan prepare $sobj $uobj; - hmscan_np_target [SplitReply [$sobj np]] + ::scan::hdb_hmscan -set NP [SplitReply [$sobj np]] set vlist [split [$sobj getvarpar 0] = ]; - set scanVariable [string trim [lindex [split [lindex $vlist 0] . ] 1]]; - set scanVarStart [lindex $vlist 1]; - set scanVarStep [lindex $vlist 2]; + ::scan::hdb_hmscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]] + ::scan::hdb_hmscan -set scan_start [lindex $vlist 1]; + ::scan::hdb_hmscan -set scan_increment [lindex $vlist 2]; - hmscan_var_name $scanVariable - hmscan_var_start $scanVarStart - hmscan_var_step $scanVarStep set scan_pt_start_time [sicstime] + + #FIXME remove dependency on hdb path + ::scan::hdb_hmscan -set feedback status BUSY + ::histogram_memory::prepare + data axis 1 [::scan::hdb_hmscan -set scan_variable] + ::hdb::set_save / true + newfile [SplitReply [SicsDataSuffix]] $nexusdic } proc hmm_count {sobj uobj point mode preset} { - hmscan_point_current $point; - hmscan_mode $mode; - hmscan_preset $preset; - set scanvar [SplitReply [hmscan_var_name]] - hmscan_var_value [SplitReply [$scanvar]] + ::scan::hdb_hmscan -set mode $mode + ::scan::hdb_hmscan -set preset $preset; + ::scan::hdb_hmscan -set feedback scanpoint $point + ::scan::hdb_hmscan -set feedback mode $mode; + ::scan::hdb_hmscan -set feedback preset $preset; + ::scan::hdb_hmscan -set feedback scan_variable_value [SplitReply [[::scan::hdb_hmscan -set scan_variable]]] ::histogram_memory::count_bm_controlled $mode $preset; } proc hmm_scan_finish {sobj uobj} { ::histogram_memory::finish; - nxreopenfile; - nxclosefile; + ::scan::hdb_hmscan -set feedback status IDLE + # Make sure that the next save command doesn't overwrite our scan data. + newfile [SplitReply [SicsDataSuffix]] } proc bm_scan_finish {sobj uobj} { -# stdscan finish $sobj $uobj; - nxreopenfile; - nxclosefile; + ::scan::hdb_bmonscan -set feedback status IDLE + # Make sure that the next save command doesn't overwrite our scan data. + newfile [SplitReply [SicsDataSuffix]] } #proc hmm_scan_finish {sobj uobj} { # nxclosefile; #} # Add an nxentry for the current scan point +#TODO Is this obsolete? proc write_nxentry {nxentryCmd point} { variable scanVarStart; variable scanVarStep; @@ -101,44 +74,45 @@ variable scanVariable scan_var scanVarStart 0 scanVarStep 1 variable scan_pt_start_time; set scanVarPos [expr {$scanVarStart + $point * $scanVarStep} ]; - nxreopenfile; + save $point +# nxreopenfile; # $nxentryCmd nxscript scan_[format "%05d" $point] $scanVariable $scanVarPos $scanVarStep $scan_pt_start_time; - $nxentryCmd nxscript entry1 $point $scanVariable $scanVarPos $scanVarStep $scan_pt_start_time; - nxclosefile; +# $nxentryCmd nxscript entry1 $point $scanVariable $scanVarPos $scanVarStep $scan_pt_start_time; +# nxclosefile; } proc bm_writepoint {sobj uobj pt} { variable bmoncounts_array set bmoncounts_array [string map {\{ "" \} ""} [SplitReply [bmonscan getcounts]]]; - write_nxentry bm_addnxscanentry $pt; + save $pt - bmonscan_counts [SplitReply [bm getcounts]] - bmonscan_np_graphics_target [SplitReply [bmonscan_np_target]] - bmonscan_point_graphics_current [SplitReply [bmonscan_point_current]] - bmonscan_var_graphics_value [SplitReply [bmonscan_var_value]] + ::scan::hdb_bmonscan -set feedback counts [SplitReply [bm getcounts]]; } #TODO Feedback for Histogram memory scan proc hmm_writepoint {sobj uobj pt} { - write_nxentry hmm_addnxscanentry $pt; + # Write hdb tree + save $pt } proc donothing {args} {} proc bm_count {sobj uobj point mode preset} { - bmonscan_point_current $point - bmonscan_mode $mode; - bmonscan_preset $preset; - set scanvar [SplitReply [bmonscan_var_name]] - bmonscan_var_value [SplitReply [$scanvar]] - bm setmode $mode - bm count $preset; + variable event; + ::scan::hdb_bmonscan -set mode $mode + ::scan::hdb_bmonscan -set preset $preset + ::scan::hdb_bmonscan -set feedback scanpoint $point; + ::scan::hdb_bmonscan -set feedback mode $mode; + ::scan::hdb_bmonscan -set feedback preset $preset; + ::scan::hdb_bmonscan -set feedback scan_variable_value [SplitReply [[::scan::hdb_bmonscan -set scan_variable]]] + ::monitor::count $mode $preset } proc bm_scan_prepare {sobj uobj} { - variable scanVarStart; - variable scanVarStep; - variable scanVariable; + variable event; + variable nexusdic + set nexusdic bmonscan.dic + variable bmoncounts_array; variable bmoncounts_axis; variable scan_pt_start_time @@ -147,148 +121,68 @@ variable scanVariable scan_var scanVarStart 0 scanVarStep 1 #TODO Parameterise varindex in some way set varindex 0; - nxcreatefile nexus_bmonscan.dic; - nxclosefile; - bmonscan_np_target [SplitReply [$sobj np]]; + ::scan::hdb_bmonscan -set feedback filename [SplitReply [dataFileName]] + ::scan::hdb_bmonscan -set NP [SplitReply [$sobj np]]; +# set event(hdb_bmonscan/graphics,dim) [::scan::hdb_bmonscan -set NP] set vlist [split [$sobj getvarpar $varindex] = ]; - set scanVariable [string trim [lindex [split [lindex $vlist 0] . ] 1]]; - set scanVarStart [lindex $vlist 1]; - set scanVarStep [lindex $vlist 2]; + ::scan::hdb_bmonscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]]; + ::scan::hdb_bmonscan -set scan_start [lindex $vlist 1]; + ::scan::hdb_bmonscan -set scan_increment [lindex $vlist 2]; set scanvar_pts [SplitReply [$sobj getvardata $varindex]] set bmoncounts_axis [string map {\{ "" \} ""} $scanvar_pts] - bmonscan_var_name $scanVariable - bmonscan_var_start $scanVarStart - bmonscan_var_step $scanVarStep - set scan_pt_start_time [sicstime] + todo_msg "SET START TIME set event(hdb_bmonscan,scan_pt_start_time) [sicstime]" + + ::scan::hdb_bmonscan -set feedback status BUSY + #FIXME remove dependency on hdb path + + array set bm_fb [::scan::hdb_bmonscan -list feedback] + data axis 1 [::scan::hdb_bmonscan -set scan_variable] + ::hdb::set_save / true + ::hdb::set_save /instrument/detector false + newfile [SplitReply [SicsDataSuffix]] $nexusdic #stdscan prepare $sobj $uobj; } - proc init {} { - variable bmoncounts_array; - variable bmoncounts_axis; - - bmonscan_numchannels [SplitReply [bmonscan getnumchan]]; - bmonscan_channel 0; - bmonscan_np_target 0; - bmonscan_point_current 0; - hmscan_numchannels [SplitReply [hmscan getnumchan]]; - hmscan_channel 0; - hmscan_np_target 0; - hmscan_point_current 0; - set bmoncounts_array [list]; - set bmoncounts_axis [list]; - } - - proc commands_hpath_setup {parent} { - set feedbackPath $parent/bmonscan/feedback - - hcommand $parent/bmonscan hdb_bmonscan - hsetprop $parent/bmonscan type command - hsetprop $parent/bmonscan priv user - - hattach $parent/bmonscan bmonscan_var_name scan_variable - hsetprop $parent/bmonscan/scan_variable argtype drivable - - hattach $parent/bmonscan bmonscan_var_start scan_start - hsetprop $parent/bmonscan/scan_start argtype float - - hattach $parent/bmonscan bmonscan_var_step scan_increment - hsetprop $parent/bmonscan/scan_increment argtype float - - hattach $parent/bmonscan/ bmonscan_np_target NP - hsetprop $parent/bmonscan/NP argtype int - - hmake $parent/bmonscan/mode user text - hsetprop $parent/bmonscan/mode argtype text - hsetprop $parent/bmonscan/mode values monitor,timer - - hmake $parent/bmonscan/preset user float - hsetprop $parent/bmonscan/preset argtype float - - hattach $parent/bmonscan/ bmonscan_channel channel - hsetprop $parent/bmonscan/channel argtype int - hsetprop $parent/bmonscan/channel min 0 - hsetprop $parent/bmonscan/channel max [SplitReply [bmonscan getnumchan]] - -# Optional feedback node - hmake $feedbackPath spy none - hattach $feedbackPath dataFileName filename - hattach $feedbackPath bmonscan_mode mode - hattach $feedbackPath bmonscan_preset preset - hmake $feedbackPath/scan_variable spy none - hattach $feedbackPath/scan_variable bmonscan_var_value value - hmake $feedbackPath/NP spy none - hattach $feedbackPath/NP bmonscan_point_current current - hattach $feedbackPath bmonscan_counts counts; - foreach fbNode [hlist $feedbackPath] { - hsetprop $feedbackPath/$fbNode privilege READ_ONLY; - } -#TODO Histogram memory scan command - } - - - proc graphics_hpath_setup {parent} { - variable bmonscanvar_axis_hpath - variable bmonscancounts_array_hpath - variable bmoncounts_array - variable bmoncounts_axis - - set bmonscanvar_axis_hpath $parent/beam_monitor_scan/axis - set bmonscancounts_array_hpath $parent/beam_monitor_scan/data - set defdim 100 - hmake $parent/beam_monitor_scan spy none; - hsetprop $parent/beam_monitor_scan type graphdata; - hsetprop $parent/beam_monitor_scan viewer default; - hsetprop $parent/beam_monitor_scan rank 1; - hattach $parent/beam_monitor_scan bmonscan_np_target dim; - hattach $parent/beam_monitor_scan bmonscan_point_graphics_current point; - hattach $parent/beam_monitor_scan bmonscan_var_graphics_value lastaxis - hattach $parent/beam_monitor_scan bmonscan_counts lastdata - hmakescript $bmonscanvar_axis_hpath "set ::scancommand::bmoncounts_axis" hdbReadOnly floatvarar $defdim - hsetprop $bmonscanvar_axis_hpath type axis - sicspoll del $bmonscanvar_axis_hpath - hmakescript $bmonscancounts_array_hpath "set ::scancommand::bmoncounts_array" hdbReadOnly floatvarar $defdim - hsetprop $bmonscancounts_array_hpath type data - sicspoll del $bmonscancounts_array_hpath - -#TODO histogram_memory_scan -# hmake $parent/histogram_memory_scan spy none; -# hsetprop $parent/histogram_memory_scan type graphdata; -# hsetprop $parent/histogram_memory_scan viewer default; -# hsetprop $parent/histogram_memory_scan rank 2; -# hattach $parent/histogram_memory_scan hmscan_np_target dim0; -# hattach $parent/histogram_memory_scan hmscan_np_target dim1; -# hattach $parent/histogram_memory_scan hmscan_point_current point; - } +# group=beam_monitor_scan +proc hdb_bmonscan_graphics {process args} { + set eid hdb_bmonscan/graphics + $process $args path beam_monitor_scan prop_list {data false control true nxsave false klass @none type graphdata viewer default rank 1} + $process $args kind event node beam_monitor_scan/dim dtype int priv user eventid $eid; + $process $args kind event node beam_monitor_scan/point dtype int priv user eventid $eid; + $process $args kind event node beam_monitor_scan/lastaxis dtype float priv user eventid $eid; + $process $args kind event node beam_monitor_scan/lastdata dtype int priv user eventid $eid; + $process $args kind script node beam_monitor_scan/axis dtype floatvarar dlen 100 priv user rscript "set ::scan::bmoncounts_axis" wscript hdbReadOnly prop_list {type axis} + $process $args kind script node beam_monitor_scan/data dtype floatvarar dlen 100 priv user rscript "set ::scan::bmoncounts_array" wscript hdbReadOnly prop_list {type data} +} } -publish ::scancommand::scan_collect user -publish ::scancommand::write_nxentry user -publish ::scancommand::hmm_count user -publish ::scancommand::hmm_scan_prepare user -publish ::scancommand::hmm_scan_finish user -publish ::scancommand::hmm_writepoint user -publish ::scancommand::donothing user +Publish ::scan::scan_collect user +Publish ::scan::write_nxentry user +Publish ::scan::hmm_count user +Publish ::scan::hmm_scan_prepare user +Publish ::scan::hmm_scan_finish user +Publish ::scan::hmm_writepoint user +Publish ::scan::donothing user -publish ::scancommand::bm_scan_prepare user -publish ::scancommand::bm_scan_finish user -publish ::scancommand::bm_writepoint user -publish ::scancommand::bm_count user +Publish ::scan::bm_scan_prepare user +Publish ::scan::bm_scan_finish user +Publish ::scan::bm_writepoint user +Publish ::scan::bm_count user bmonscan configure script -bmonscan function writeheader ::scancommand::donothing -bmonscan function writepoint ::scancommand::bm_writepoint -bmonscan function count ::scancommand::bm_count -#bmonscan function collect ::scancommand::scan_collect -bmonscan function prepare ::scancommand::bm_scan_prepare -bmonscan function finish ::scancommand::bm_scan_finish +bmonscan function writeheader ::scan::donothing +bmonscan function writepoint ::scan::bm_writepoint +bmonscan function count ::scan::bm_count +#bmonscan function collect ::scan::scan_collect +bmonscan function prepare ::scan::bm_scan_prepare +bmonscan function finish ::scan::bm_scan_finish -#scan2 function writeheader ::scancommand::donothing -#scan2 function writepoint ::scancommand::nxaddpoint -#scan2 function prepare ::scancommand::hmm_scan_prepare +#scan2 function writeheader ::scan::donothing +#scan2 function writepoint ::scan::nxaddpoint +#scan2 function prepare ::scan::hmm_scan_prepare # Configure script mode, then we can configure all the scan callbacks. # The scan list command can be used to check that the callbacks # are properly defined. @@ -306,29 +200,57 @@ scan2 function finish ::histogram_memory::hs_finish hmscan configure script #hmscan function prepare hdbprepare #hmscan function collect hdbcollect -hmscan function writeheader ::scancommand::donothing -hmscan function writepoint ::scancommand::hmm_writepoint -hmscan function count ::scancommand::hmm_count -#hmscan function collect ::scancommand::scan_collect -bmonscan function prepare ::scancommand::bm_scan_prepare -hmscan function prepare ::scancommand::hmm_scan_prepare -hmscan function finish ::scancommand::hmm_scan_finish -# Wombat proc hdb_hmscan {scanvar scanstart scanincr scanend mode preset} { -proc hdb_bmonscan {scanvar scanstart scanincr np mode preset channel} { +hmscan function writeheader ::scan::donothing +hmscan function writepoint ::scan::hmm_writepoint +hmscan function count ::scan::hmm_count +#hmscan function collect ::scan::scan_collect +hmscan function prepare ::scan::hmm_scan_prepare +hmscan function finish ::scan::hmm_scan_finish + +namespace eval scan { +command hdb_bmonscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} { + bmonscan clear # bmonscan configure script - bmonscan add $scanvar $scanstart $scanincr + bmonscan add $scan_variable $scan_start $scan_increment bmonscan setchannel $channel; - set status [catch {bmonscan run $np $mode $preset} msg] + set status [catch {bmonscan run $NP $mode $preset} msg] # bmonscan configure soft if {$status == 0} { return $msg } else { - clientput "hdb_bmonscan ERROR: $msg" + clientput "ERROR, [info level 0], $msg" error $msg } + + } +::scan::hdb_bmonscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status +::scan::hdb_bmonscan -set feedback status IDLE + -publish hdb_bmonscan user +command hdb_hmscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} { + + hmscan clear + + hmscan add $scan_variable $scan_start $scan_increment + hmscan setchannel $channel; + set status [catch {hmscan run $NP $mode $preset} msg] + + if {$status == 0} { + return $msg + } else { + clientput "ERROR, [info level 0], $msg" + error $msg + } + + +} +::scan::hdb_hmscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status +::scan::hdb_hmscan -set feedback status IDLE +} +publish ::scan::hdb_bmonscan_graphics user +sicslist setatt ::scan::hdb_bmonscan long_name bmonscan +sicslist setatt ::scan::hdb_hmscan long_name hmscan diff --git a/site_ansto/instrument/reflectometer/Makefile b/site_ansto/instrument/reflectometer/Makefile index 8ecc9b71..2077f983 100644 --- a/site_ansto/instrument/reflectometer/Makefile +++ b/site_ansto/instrument/reflectometer/Makefile @@ -1,14 +1,5 @@ -cfPath=config/motors - -all: script_val +all: make -C config - -script_val: SVmotors - - -SVmotors: $(cfPath)/motor_configuration.tcl - ../mksim_config.tcl -f $(cfPath)/motor_configuration.tcl > script_validator/$(cfPath)/motor_configuration.tcl - clean: make -C config clean diff --git a/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT b/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT index 0db6ee7a..c3d73db2 100644 --- a/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT @@ -1,7 +1,10 @@ config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl -config/hipadaba/common_hipadaba_configuration.tcl +config/hipadaba/hipadaba_configuration_common.tcl +config/hipadaba/common_instrument_dictionary.tcl +config/hipadaba/instdict_specification.tcl config/hmm/hmm_configuration_common_1.tcl +config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl diff --git a/site_ansto/instrument/reflectometer/config/chopper/chopper.tcl b/site_ansto/instrument/reflectometer/config/chopper/chopper.tcl index 99dec37c..d8a6f24e 100644 --- a/site_ansto/instrument/reflectometer/config/chopper/chopper.tcl +++ b/site_ansto/instrument/reflectometer/config/chopper/chopper.tcl @@ -1,15 +1,4 @@ -#START SERVER CONFIGURATION SECTION -set sicsroot /usr/local/sics -source dmc2280_util.tcl -source server_config.tcl -#END SERVER CONFIGURATION SECTION - -######################################## -# INSTRUMENT SPECIFIC CONFIGURATION -VarMake Instrument Text Internal -Instrument Platypus -Instrument lock - +if 0 { # Chopper NCS013 communications set chopper_controller(host) 137.157.202.130 set chopper_controller(port) 10000 @@ -27,3 +16,11 @@ MakeChopper chopperController tcpdocho [params \ password $chopper_controller(password) \ ] ChopperAdapter chspeed chopperController speed 0 10 +} +namespace eval ::chopper { + command set_freq {float: frequency} { + for {set i 0} {$i < $frequency} {incr i} { + clientput chop + } + } +} diff --git a/site_ansto/instrument/reflectometer/config/counter/counter.tcl b/site_ansto/instrument/reflectometer/config/counter/counter.tcl index e69de29b..0f492c55 100644 --- a/site_ansto/instrument/reflectometer/config/counter/counter.tcl +++ b/site_ansto/instrument/reflectometer/config/counter/counter.tcl @@ -0,0 +1,17 @@ +set sim_mode [SplitReply [counter_simulation]] +if {$sim_mode == "true"} { + MakeCounter bm SIM 0.0; +} else { +# Make and configure an ANSTO beam monitor counter. +# This must be sourced before the hmm_configuration.tcl until we separate the scan setup from the hmm setup + MakeCounter bm anstomonitor [ params host "das1-[SplitReply [instrument]]" port "30000" ] +} + +source $cfPath(counter)/counter_common_1.tcl +unset sim_mode + +## TODO Put all the counter macros in the counter namespace +namespace eval counter { + proc set_sobj_attributes {} { + } +} diff --git a/site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl b/site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl index eae0fc03..3aaa4d83 100644 --- a/site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl +++ b/site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl @@ -1 +1 @@ -source $cfPath(hipadaba)/common_hipadaba_configuration.tcl +source $cfPath(hipadaba)/hipadaba_configuration_common.tcl diff --git a/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl index e69de29b..2053788f 100644 --- a/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl @@ -0,0 +1,84 @@ +set sim_mode [SplitReply [hmm_simulation]] +if {$sim_mode == "true"} { + MakeHM hmm SIM; + namespace eval histogram_memory { + proc hmc {_start _preset _mode _pause} { + bm mode $_mode; + bm preset $_preset; + hmm countblock; + } + } +} else { + MakeHM hmm anstohttp; + MakeHMControl_ANSTO hmc bm hmm; +} + +source $cfPath(hmm)/hmm_configuration_common_1.tcl +if {$sim_mode == "true"} { + proc ::histogram_memory::hmm_initialize {} { + hmm configure hmaddress http://das1-[SplitReply [instrument]]:8080; + hmm configure username spy; + hmm configure password 007; + hmm configure hmDataPath ../HMData; + } +} +# Configure to upload a complete configuration to the histogram server. +# In this case it's the main config file plus the FAT, BAT and OAT files +# in the same direcory as the SICS executable (for this example). +# Alternatives: +# - A partial config could be uploaded instead - e.g. just the main config file, +# in that case the main config file points to a set of FAT, BAT OAT files +# located on the server. +# - The histogram server could configure itself from a config file set +# kept on the local file system (not automated presently, manual control only) +# - Or, no configuration at all could be uploaded, the +# histogram server can configure itself using its default config files. +proc ::histogram_memory::setmode {mode} { + hmm_mode $mode; + set sim_mode [SplitReply [hmm_simulation]]; + + switch $mode { + pulser { + if {$sim_mode == "true"} { + hmm configure oat_nyc_eff 1024; + hmm configure oat_nxc_eff 64; + hmm configure oat_ntc_eff 1; + } + _hmm_hor_channel_name tube_pair_number + _hmm_hor_axis tube_pair_number + _hmm_hor_axis_alias dcolindex + _hmm_vert_axis vertical_channel_number + _hmm_vert_axis_alias drowindex + hmm configure hmconfigscript "returnconfigfile [SplitReply [hmm_user_configpath]]/anstohm_full_MESYTEC_PULSER.xml" + } + calibration { + if {$sim_mode == "true"} { + hmm configure oat_nyc_eff 1024; + hmm configure oat_nxc_eff 64; + hmm configure oat_ntc_eff 1; + } + _hmm_hor_channel_name tube_pair_number + _hmm_hor_axis tube_pair_number + _hmm_hor_axis_alias dcolindex + _hmm_vert_axis vertical_channel_number + _hmm_vert_axis_alias drowindex + hmm configure hmconfigscript "returnconfigfile [SplitReply [hmm_user_configpath]]/anstohm_full_nofolding.xml" + } + normal - + default { + if {$sim_mode == "true"} { + hmm configure oat_nyc_eff 512; + hmm configure oat_nxc_eff 128; + hmm configure oat_ntc_eff 1; + } + _hmm_hor_channel_name horizontal_channel_number + _hmm_hor_axis polar_angle + _hmm_hor_axis_alias dtheta + _hmm_vert_axis vertical_channel_number + _hmm_vert_axis_alias drowindex + OAT_TABLE X {-210.5 -209.5} Y {-110.5 -109.5} T {0 20000} NTC 5 + ::histogram_memory::configure_server Filler_defaults FASTCOMTEC + } + } +} + diff --git a/site_ansto/instrument/reflectometer/config/motors/motor_configuration.tcl b/site_ansto/instrument/reflectometer/config/motors/motor_configuration.tcl index a6162434..555d4bdd 100644 --- a/site_ansto/instrument/reflectometer/config/motors/motor_configuration.tcl +++ b/site_ansto/instrument/reflectometer/config/motors/motor_configuration.tcl @@ -1,7 +1,7 @@ -# $Revision: 1.16 $ -# $Date: 2007-06-27 01:02:36 $ +# $Revision: 1.17 $ +# $Date: 2007-07-22 05:23:40 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ # START MOTOR CONFIGURATION @@ -178,6 +178,14 @@ set ss4l_HiRange 14.0 set ss4u_HiRange 27.0 set ss4d_HiRange 8.0 } +set slit1VGroup first/vertical +set slit1HGroup first/horizontal +set slit2VGroup second/vertical +set slit2HGroup second/horizontal +set slit3VGroup third/vertical +set slit3HGroup third/horizontal +set slit4VGroup fourth/vertical +set slit4HGroup fourth/horizontal # set movecount high to reduce the frequency of # hnotify messages to a reasonable level @@ -285,7 +293,7 @@ Motor st3vt $motor_driver_type [params \ absEnc 1\ absEncHome $st3vt_home\ cntsPerX -8192] -st3vt part aperture.3/vertical +st3vt part aperture.$slit3VGroup st3vt long_name st3vt st3vt softlowerlim 0 st3vt softupperlim 253 @@ -305,7 +313,7 @@ Motor st4vt $motor_driver_type [params \ absEnc 1\ absEncHome $st4vt_home\ cntsPerX -8192] -st4vt part aperture.4/vertical +st4vt part aperture.$slit4VGroup st4vt long_name st4vt st4vt softlowerlim 0 st4vt softupperlim 249 @@ -481,7 +489,7 @@ Motor ss1l $motor_driver_type [params \ maxDecel 5\ stepsPerX $slitStepRate\ motorHome $ss1l_Home] -ss1l part aperture.1/horizontal +ss1l part aperture.$slit1HGroup ss1l long_name left ss1l softlowerlim $ss1l_LoRange ss1l softupperlim $ss1l_HiRange @@ -499,7 +507,7 @@ Motor ss1r $motor_driver_type [params \ maxDecel 5\ stepsPerX -$slitStepRate\ motorHome $ss1r_Home] -ss1r part aperture.1/horizontal +ss1r part aperture.$slit1HGroup ss1r long_name right ss1r softlowerlim $ss1r_LoRange ss1r softupperlim $ss1r_HiRange @@ -517,7 +525,7 @@ Motor ss1u $motor_driver_type [params \ maxDecel 5\ stepsPerX -$slitStepRate\ motorHome $ss1u_Home] -ss1u part aperture.1/vertical +ss1u part aperture.$slit1VGroup ss1u long_name upper ss1u softlowerlim $ss1u_LoRange ss1u softupperlim $ss1u_HiRange @@ -535,7 +543,7 @@ Motor ss1d $motor_driver_type [params \ maxDecel 5\ stepsPerX $slitStepRate\ motorHome $ss1d_Home] -ss1d part aperture.1/vertical +ss1d part aperture.$slit1VGroup ss1d long_name lower ss1d softlowerlim $ss1d_LoRange ss1d softupperlim $ss1d_HiRange @@ -553,7 +561,7 @@ Motor ss2l $motor_driver_type [params \ maxDecel 5\ stepsPerX $slitStepRate\ motorHome $ss2l_Home] -ss2l part aperture.2/horizontal +ss2l part aperture.$slit2HGroup ss2l long_name left ss2l softlowerlim $ss2l_LoRange ss2l softupperlim $ss2l_HiRange @@ -571,7 +579,7 @@ Motor ss2r $motor_driver_type [params \ maxDecel 5\ stepsPerX -$slitStepRate\ motorHome $ss2r_Home] -ss2r part aperture.2/horizontal +ss2r part aperture.$slit2HGroup ss2r long_name right ss2r softlowerlim $ss2r_LoRange ss2r softupperlim $ss2r_HiRange @@ -589,7 +597,7 @@ Motor ss2u $motor_driver_type [params \ maxDecel 5\ stepsPerX -$slitStepRate\ motorHome $ss2u_Home] -ss2u part aperture.2/vertical +ss2u part aperture.$slit2VGroup ss2u long_name upper ss2u softlowerlim $ss2u_LoRange ss2u softupperlim $ss2u_HiRange @@ -607,7 +615,7 @@ Motor ss2d $motor_driver_type [params \ maxDecel 5\ stepsPerX $slitStepRate\ motorHome $ss2d_Home] -ss2d part aperture.2/vertical +ss2d part aperture.$slit2VGroup ss2d long_name lower ss2d softlowerlim $ss2d_LoRange ss2d softupperlim $ss2d_HiRange @@ -632,7 +640,7 @@ Motor ss3d $motor_driver_type [params \ maxDecel 5\ stepsPerX $slitStepRate\ motorHome $ss3d_Home] -ss3d part aperture.3/vertical +ss3d part aperture.$slit3VGroup ss3d long_name lower ss3d softlowerlim $ss3d_LoRange ss3d softupperlim $ss3d_HiRange @@ -650,7 +658,7 @@ Motor ss3u $motor_driver_type [params \ maxDecel 5\ stepsPerX -$slitStepRate\ motorHome $ss3u_Home] -ss3u part aperture.3/vertical +ss3u part aperture.$slit3VGroup ss3u long_name upper ss3u softlowerlim $ss3u_LoRange ss3u softupperlim $ss3u_HiRange @@ -668,7 +676,7 @@ Motor ss3l $motor_driver_type [params \ maxDecel 5\ stepsPerX $slitStepRate\ motorHome $ss3l_Home] -ss3l part aperture.3/horizontal +ss3l part aperture.$slit3HGroup ss3l long_name left ss3l softlowerlim $ss3l_LoRange ss3l softupperlim $ss3l_HiRange @@ -686,7 +694,7 @@ Motor ss3r $motor_driver_type [params \ maxDecel 5\ stepsPerX -$slitStepRate\ motorHome $ss3r_Home] -ss3r part aperture.3/horizontal +ss3r part aperture.$slit3HGroup ss3r long_name right ss3r softlowerlim $ss3r_LoRange ss3r softupperlim $ss3r_HiRange @@ -704,7 +712,7 @@ Motor ss4d $motor_driver_type [params \ maxDecel 5\ stepsPerX $slitStepRate\ motorHome $ss4d_Home] -ss4d part aperture.4/vertical +ss4d part aperture.$slit4VGroup ss4d long_name lower ss4d softlowerlim $ss4d_LoRange ss4d softupperlim $ss4d_HiRange @@ -722,7 +730,7 @@ Motor ss4u $motor_driver_type [params \ maxDecel 5\ stepsPerX -$slitStepRate\ motorHome $ss4u_Home] -ss4u part aperture.4/vertical +ss4u part aperture.$slit4VGroup ss4u long_name upper ss4u softlowerlim $ss4u_LoRange ss4u softupperlim $ss4u_HiRange @@ -740,7 +748,7 @@ Motor ss4l $motor_driver_type [params \ maxDecel 5\ stepsPerX $slitStepRate\ motorHome $ss4l_Home] -ss4l part aperture.4/horizontal +ss4l part aperture.$slit4HGroup ss4l long_name left ss4l softlowerlim $ss4l_LoRange ss4l softupperlim $ss4l_HiRange @@ -758,7 +766,7 @@ Motor ss4r $motor_driver_type [params \ maxDecel 5\ stepsPerX -$slitStepRate\ motorHome $ss4r_Home] -ss4r part aperture.4/horizontal +ss4r part aperture.$slit4HGroup ss4r long_name right ss4r softlowerlim $ss4r_LoRange ss4r softupperlim $ss4r_HiRange @@ -838,7 +846,7 @@ proc set_gap_offset {m1 m2 val} { } # make_gap_motors virt_width_motor virt_offset_motor real_high_motor real_low_motor -proc make_gap_motors {vm1 vm2 m1 m2} { +proc make_gap_motors {vm1 vm1_name vm2 vm2_name m1 m2 aunits agroup} { eval "proc get_$vm1 {} { get_gap_width $m1 $m2 }" set v {$var} eval "proc set_$vm1 {var} { set_gap_width $m1 $m2 $v }" @@ -846,7 +854,9 @@ proc make_gap_motors {vm1 vm2 m1 m2} { $vm1 readscript get_$vm1 $vm1 drivescript set_$vm1 publish get_$vm1 user +sicslist setatt get_$vm1 privilege internal publish set_$vm1 user +sicslist setatt set_$vm1 privilege internal eval "proc get_$vm2 {} { get_gap_offset $m1 $m2 }" set v {$var} @@ -855,19 +865,32 @@ publish set_$vm1 user $vm2 readscript get_$vm2 $vm2 drivescript set_$vm2 publish get_$vm2 user +sicslist setatt get_$vm2 privilege internal publish set_$vm2 user +sicslist setatt set_$vm2 privilege internal + +sicslist setatt $vm1 units $aunits +sicslist setatt $vm1 klass aperture +sicslist setatt $vm1 long_name $vm1_name +sicslist setatt $vm1 group $agroup +sicslist setatt $vm2 units $aunits +sicslist setatt $vm2 klass aperture +sicslist setatt $vm2 long_name $vm2_name +sicslist setatt $vm2 group $agroup } -make_gap_motors ss1vg ss1vo ss1u ss1d -make_gap_motors ss1hg ss1ho ss1r ss1l +make_gap_motors ss1vg gap ss1vo offset ss1u ss1d mm $slit1VGroup +make_gap_motors ss1hg gap ss1ho offset ss1r ss1l mm $slit1HGroup -make_gap_motors ss2vg ss2vo ss2u ss2d -make_gap_motors ss2hg ss2ho ss2r ss2l +make_gap_motors ss2vg gap ss2vo offset ss2u ss2d mm $slit2VGroup +make_gap_motors ss2hg gap ss2ho offset ss2r ss2l mm $slit2HGroup -make_gap_motors ss3vg ss3vo ss3u ss3d -make_gap_motors ss3hg ss3ho ss3r ss3l +make_gap_motors ss3vg gap ss3vo offset ss3u ss3d mm $slit3VGroup +make_gap_motors ss3hg gap ss3ho offset ss3r ss3l mm $slit3HGroup -make_gap_motors ss4vg ss4vo ss4u ss4d -make_gap_motors ss4hg ss4ho ss4r ss4l +make_gap_motors ss4vg gap ss4vo offset ss4u ss4d mm $slit4VGroup +make_gap_motors ss4hg gap ss4ho offset ss4r ss4l mm $slit4HGroup +proc motor_set_sobj_attributes {} { +} # END MOTOR CONFIGURATION diff --git a/site_ansto/instrument/reflectometer/config/scan/scan.tcl b/site_ansto/instrument/reflectometer/config/scan/scan.tcl index 3e716b42..4fd616d2 100644 --- a/site_ansto/instrument/reflectometer/config/scan/scan.tcl +++ b/site_ansto/instrument/reflectometer/config/scan/scan.tcl @@ -1,8 +1 @@ -namespace eval scancommand { - proc init {} { - } - proc commands_hpath_setup {parent} { - } - proc graphics_hpath_setup {parent} { - } -} +source $cfPath(scan)/scan_common_1.tcl diff --git a/site_ansto/instrument/reflectometer/platypus_configuration.tcl b/site_ansto/instrument/reflectometer/platypus_configuration.tcl index d15cf3b6..3dc64bec 100644 --- a/site_ansto/instrument/reflectometer/platypus_configuration.tcl +++ b/site_ansto/instrument/reflectometer/platypus_configuration.tcl @@ -1,11 +1,12 @@ -# $Revision: 1.10 $ -# $Date: 2007-07-11 22:49:33 $ +# $Revision: 1.11 $ +# $Date: 2007-07-22 05:23:40 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ # Required by server_config.tcl -VarMake Instrument Text Internal -Instrument Platypus +VarMake Instrument Text Internal +sicslist setatt Instrument privilege internal +Instrument platypus Instrument lock #START SERVER CONFIGURATION SECTION @@ -16,19 +17,42 @@ source server_config.tcl ######################################## # INSTRUMENT SPECIFIC CONFIGURATION +#set hmm_mode normal -fileeval $cfPath(chopper)/chopper.tcl fileeval $cfPath(motors)/motor_configuration.tcl -#fileeval gen_hipadaba.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl fileeval $cfPath(scan)/scan.tcl +fileeval $cfPath(chopper)/chopper.tcl source $cfPath(hipadaba)/hipadaba_configuration.tcl source gumxml.tcl -MakeStateMon +#::histogram_memory::setmode pulser +#::histogram_memory::setmode calibration +::histogram_memory::setmode normal +#::histogram_memory::hmm_initialize +::histogram_memory::hmm_setup transparent 0 3 oat_nyc_eff oat_nxc_eff oat_ntc_eff +hmm_start 0 +MakeStateMon hmscan + +proc instrument_set_sobj_attributes {} { + + motor_set_sobj_attributes + ::utility::set_motor_attributes + ::utility::set_histomem_attributes + ::utility::set_sobj_attributes + ::counter::set_sobj_attributes + ::nexus::set_sobj_attributes + ::histogram_memory::set_sobj_attributes +## TODO move the following to the new ansto gumxml.tcl + sicslist setatt getgumtreexml privilege internal +} + +instrument_set_sobj_attributes +buildHDB instrument_dictionary +#buildHDB [instname]_dictionary fileeval extraconfig.tcl diff --git a/site_ansto/instrument/sans/Makefile b/site_ansto/instrument/sans/Makefile index 8ecc9b71..2077f983 100644 --- a/site_ansto/instrument/sans/Makefile +++ b/site_ansto/instrument/sans/Makefile @@ -1,14 +1,5 @@ -cfPath=config/motors - -all: script_val +all: make -C config - -script_val: SVmotors - - -SVmotors: $(cfPath)/motor_configuration.tcl - ../mksim_config.tcl -f $(cfPath)/motor_configuration.tcl > script_validator/$(cfPath)/motor_configuration.tcl - clean: make -C config clean diff --git a/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT b/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT index 0db6ee7a..c3d73db2 100644 --- a/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT @@ -1,7 +1,10 @@ config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl -config/hipadaba/common_hipadaba_configuration.tcl +config/hipadaba/hipadaba_configuration_common.tcl +config/hipadaba/common_instrument_dictionary.tcl +config/hipadaba/instdict_specification.tcl config/hmm/hmm_configuration_common_1.tcl +config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl diff --git a/site_ansto/instrument/sans/config/counter/counter.tcl b/site_ansto/instrument/sans/config/counter/counter.tcl index 46409041..0f492c55 100644 --- a/site_ansto/instrument/sans/config/counter/counter.tcl +++ b/site_ansto/instrument/sans/config/counter/counter.tcl @@ -1 +1,17 @@ -# TODO +set sim_mode [SplitReply [counter_simulation]] +if {$sim_mode == "true"} { + MakeCounter bm SIM 0.0; +} else { +# Make and configure an ANSTO beam monitor counter. +# This must be sourced before the hmm_configuration.tcl until we separate the scan setup from the hmm setup + MakeCounter bm anstomonitor [ params host "das1-[SplitReply [instrument]]" port "30000" ] +} + +source $cfPath(counter)/counter_common_1.tcl +unset sim_mode + +## TODO Put all the counter macros in the counter namespace +namespace eval counter { + proc set_sobj_attributes {} { + } +} diff --git a/site_ansto/instrument/sans/config/hipadaba/hipadaba_configuration.tcl b/site_ansto/instrument/sans/config/hipadaba/hipadaba_configuration.tcl index eae0fc03..3aaa4d83 100644 --- a/site_ansto/instrument/sans/config/hipadaba/hipadaba_configuration.tcl +++ b/site_ansto/instrument/sans/config/hipadaba/hipadaba_configuration.tcl @@ -1 +1 @@ -source $cfPath(hipadaba)/common_hipadaba_configuration.tcl +source $cfPath(hipadaba)/hipadaba_configuration_common.tcl diff --git a/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl index e69de29b..2053788f 100644 --- a/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl @@ -0,0 +1,84 @@ +set sim_mode [SplitReply [hmm_simulation]] +if {$sim_mode == "true"} { + MakeHM hmm SIM; + namespace eval histogram_memory { + proc hmc {_start _preset _mode _pause} { + bm mode $_mode; + bm preset $_preset; + hmm countblock; + } + } +} else { + MakeHM hmm anstohttp; + MakeHMControl_ANSTO hmc bm hmm; +} + +source $cfPath(hmm)/hmm_configuration_common_1.tcl +if {$sim_mode == "true"} { + proc ::histogram_memory::hmm_initialize {} { + hmm configure hmaddress http://das1-[SplitReply [instrument]]:8080; + hmm configure username spy; + hmm configure password 007; + hmm configure hmDataPath ../HMData; + } +} +# Configure to upload a complete configuration to the histogram server. +# In this case it's the main config file plus the FAT, BAT and OAT files +# in the same direcory as the SICS executable (for this example). +# Alternatives: +# - A partial config could be uploaded instead - e.g. just the main config file, +# in that case the main config file points to a set of FAT, BAT OAT files +# located on the server. +# - The histogram server could configure itself from a config file set +# kept on the local file system (not automated presently, manual control only) +# - Or, no configuration at all could be uploaded, the +# histogram server can configure itself using its default config files. +proc ::histogram_memory::setmode {mode} { + hmm_mode $mode; + set sim_mode [SplitReply [hmm_simulation]]; + + switch $mode { + pulser { + if {$sim_mode == "true"} { + hmm configure oat_nyc_eff 1024; + hmm configure oat_nxc_eff 64; + hmm configure oat_ntc_eff 1; + } + _hmm_hor_channel_name tube_pair_number + _hmm_hor_axis tube_pair_number + _hmm_hor_axis_alias dcolindex + _hmm_vert_axis vertical_channel_number + _hmm_vert_axis_alias drowindex + hmm configure hmconfigscript "returnconfigfile [SplitReply [hmm_user_configpath]]/anstohm_full_MESYTEC_PULSER.xml" + } + calibration { + if {$sim_mode == "true"} { + hmm configure oat_nyc_eff 1024; + hmm configure oat_nxc_eff 64; + hmm configure oat_ntc_eff 1; + } + _hmm_hor_channel_name tube_pair_number + _hmm_hor_axis tube_pair_number + _hmm_hor_axis_alias dcolindex + _hmm_vert_axis vertical_channel_number + _hmm_vert_axis_alias drowindex + hmm configure hmconfigscript "returnconfigfile [SplitReply [hmm_user_configpath]]/anstohm_full_nofolding.xml" + } + normal - + default { + if {$sim_mode == "true"} { + hmm configure oat_nyc_eff 512; + hmm configure oat_nxc_eff 128; + hmm configure oat_ntc_eff 1; + } + _hmm_hor_channel_name horizontal_channel_number + _hmm_hor_axis polar_angle + _hmm_hor_axis_alias dtheta + _hmm_vert_axis vertical_channel_number + _hmm_vert_axis_alias drowindex + OAT_TABLE X {-210.5 -209.5} Y {-110.5 -109.5} T {0 20000} NTC 5 + ::histogram_memory::configure_server Filler_defaults FASTCOMTEC + } + } +} + diff --git a/site_ansto/instrument/sans/config/motors/motor_configuration.tcl b/site_ansto/instrument/sans/config/motors/motor_configuration.tcl index 45171746..0d06dad2 100644 --- a/site_ansto/instrument/sans/config/motors/motor_configuration.tcl +++ b/site_ansto/instrument/sans/config/motors/motor_configuration.tcl @@ -1,7 +1,7 @@ -# $Revision: 1.2 $ -# $Date: 2007-07-20 00:05:00 $ +# $Revision: 1.3 $ +# $Date: 2007-07-22 05:23:40 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ # START MOTOR CONFIGURATION @@ -766,4 +766,6 @@ pol softlowerlim 0 pol softupperlim 3 pol home 0 +proc motor_set_sobj_attributes {} { +} # END MOTOR CONFIGURATION diff --git a/site_ansto/instrument/sans/config/nexus/nexus_bmonscan.dic b/site_ansto/instrument/sans/config/nexus/nexus_bmonscan.dic index 26139180..2041fc3d 100644 --- a/site_ansto/instrument/sans/config/nexus/nexus_bmonscan.dic +++ b/site_ansto/instrument/sans/config/nexus/nexus_bmonscan.dic @@ -18,7 +18,7 @@ row_index_name=vertical_channel_number #---------- NXentry level etitle=/$(entryName),NXentry/SDS title -type NX_CHAR program_name=/$(entryName),NXentry/SDS program_name -type NX_CHAR \ --attr {nx_schema_release_tag,$Name: not supported by cvs2svn $} -attr {nx_schema_revision_num,$Revision: 1.2 $} +-attr {nx_schema_release_tag,$Name: not supported by cvs2svn $} -attr {nx_schema_revision_num,$Revision: 1.3 $} erun=/$(entryName),NXentry/SDS run_number -type NX_INT32 -rank 1 -dim {-1} estart=/$(entryName),NXentry/SDS start_time -type NX_CHAR @@ -65,6 +65,7 @@ scandata=/$(entryName),NXentry/data,NXdata/NXVGROUP scanhoraxis=/$(entryName),NXentry/data,NXdata/NXVGROUP scanvertaxis=/$(entryName),NXentry/data,NXdata/NXVGROUP scanvar=/$(entryName),NXentry/data,NXdata/NXVGROUP +scantwotheta=/$(entryName),NXentry/scan_step,NXdata/SDS two_theta -type NX_FLOAT32 -attr {units,degree} -attr {long_name,two_theta} scanstep=/$(entryName),NXentry/scan_step,NXdata/SDS value -type NX_FLOAT32 -attr {units,degree} -attr {long_name,stepsize} #histogram=/$(entryName),NXentry/histogram,NXdata/NXVGROUP #scanvar=/$(entryName),NXentry/$(scan_variable),NXdata/NXVGROUP diff --git a/site_ansto/instrument/sans/config/nexus/nexus_hmscan.dic b/site_ansto/instrument/sans/config/nexus/nexus_hmscan.dic index 8ba91a74..cc6028f4 100644 --- a/site_ansto/instrument/sans/config/nexus/nexus_hmscan.dic +++ b/site_ansto/instrument/sans/config/nexus/nexus_hmscan.dic @@ -18,7 +18,7 @@ row_index_name=vertical_channel_number #---------- NXentry level etitle=/$(entryName),NXentry/SDS title -type NX_CHAR program_name=/$(entryName),NXentry/SDS program_name -type NX_CHAR \ --attr {nx_schema_release_tag,$Name: not supported by cvs2svn $} -attr {nx_schema_revision_num,$Revision: 1.2 $} +-attr {nx_schema_release_tag,$Name: not supported by cvs2svn $} -attr {nx_schema_revision_num,$Revision: 1.3 $} erun=/$(entryName),NXentry/SDS run_number -type NX_INT32 -rank 1 -dim {-1} estart=/$(entryName),NXentry/SDS start_time -type NX_CHAR @@ -55,7 +55,7 @@ dradius=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS ra dheight=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS height -type NX_FLOAT32 -attr {units,mm} detangle_rad=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS arc -type NX_FLOAT32 -attr {units,radians} detangle_degrees=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS arc -type NX_FLOAT32 -attr {units,degrees} -dtheta=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS polar_angle -type NX_FLOAT32 -LZW -rank 2 -dim {-1,$(padim1)} -attr {units,degrees} +dtheta=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS two_theta -type NX_FLOAT32 -LZW -rank 2 -dim {-1,$(padim1)} -attr {units,degrees} dvaxis=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS y_pixel_offset -type NX_FLOAT32 -LZW -rank 1 -dim {$(padim0)} -attr {units,mm} dhaxis=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS x_pixel_offset -type NX_FLOAT32 -LZW -rank 1 -dim {$(padim1)} -attr {units,mm} drowindex=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS $(row_index_name) -type NX_INT32 -LZW -rank 1 -dim {$(padim0)} @@ -90,6 +90,7 @@ scandata=/$(entryName),NXentry/data,NXdata/NXVGROUP scanhoraxis=/$(entryName),NXentry/data,NXdata/NXVGROUP scanvertaxis=/$(entryName),NXentry/data,NXdata/NXVGROUP scanvar=/$(entryName),NXentry/data,NXdata/NXVGROUP +scantwotheta=/$(entryName),NXentry/scan_step,NXdata/SDS two_theta -type NX_FLOAT32 -attr {units,degree} -attr {long_name,two_theta} scanstep=/$(entryName),NXentry/scan_step,NXdata/SDS value -type NX_FLOAT32 -attr {units,degree} -attr {long_name,stepsize} #histogram=/$(entryName),NXentry/histogram,NXdata/NXVGROUP #scanvar=/$(entryName),NXentry/$(scan_variable),NXdata/NXVGROUP diff --git a/site_ansto/instrument/sans/config/plc/plc.tcl b/site_ansto/instrument/sans/config/plc/plc.tcl index 017d5680..80ff9dfb 100644 --- a/site_ansto/instrument/sans/config/plc/plc.tcl +++ b/site_ansto/instrument/sans/config/plc/plc.tcl @@ -1,5 +1,5 @@ -#MakeAsyncQueue plc_chan SafetyPLC 137.157.204.65 30002 -#MakeSafetyPLC plc plc_chan 0 +MakeAsyncQueue plc_chan SafetyPLC 137.157.204.65 30002 +MakeSafetyPLC plc plc_chan 0 source $cfPath(plc)/plc_common_1.tcl diff --git a/site_ansto/instrument/sans/config/scan/scan.tcl b/site_ansto/instrument/sans/config/scan/scan.tcl index 3e716b42..4fd616d2 100644 --- a/site_ansto/instrument/sans/config/scan/scan.tcl +++ b/site_ansto/instrument/sans/config/scan/scan.tcl @@ -1,8 +1 @@ -namespace eval scancommand { - proc init {} { - } - proc commands_hpath_setup {parent} { - } - proc graphics_hpath_setup {parent} { - } -} +source $cfPath(scan)/scan_common_1.tcl diff --git a/site_ansto/instrument/sans/config/velsel/velsel.tcl b/site_ansto/instrument/sans/config/velsel/velsel.tcl index 78b9d1b9..64d0ee62 100644 --- a/site_ansto/instrument/sans/config/velsel/velsel.tcl +++ b/site_ansto/instrument/sans/config/velsel/velsel.tcl @@ -1,16 +1,5 @@ -#START SERVER CONFIGURATION SECTION -set sicsroot /usr/local/sics -source dmc2280_util.tcl -source server_config.tcl -#END SERVER CONFIGURATION SECTION - -######################################## -# INSTRUMENT SPECIFIC CONFIGURATION -VarMake Instrument Text Internal -Instrument Quokka -Instrument lock - -# Chopper NCS013 communications +puts "velsel.tcl NOT YET AVAILABLE" +if 0 { set velsel_controller(host) 137.157.202.70 set velsel_controller(port) 10000 set velsel_controller(user) NVS @@ -28,3 +17,4 @@ MakeTCPSelector velsel [params \ velsel add 3600 4900 velsel add 7800 10500 velsel add 30000 30000 +} diff --git a/site_ansto/instrument/sans/quokka_configuration.tcl b/site_ansto/instrument/sans/quokka_configuration.tcl index f5f74fc4..5508facb 100644 --- a/site_ansto/instrument/sans/quokka_configuration.tcl +++ b/site_ansto/instrument/sans/quokka_configuration.tcl @@ -1,11 +1,12 @@ -# $Revision: 1.1 $ -# $Date: 2007-07-09 05:24:46 $ +# $Revision: 1.2 $ +# $Date: 2007-07-22 05:23:40 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ # Required by server_config.tcl -VarMake Instrument Text Internal -Instrument Quokka +VarMake Instrument Text Internal +sicslist setatt Instrument privilege internal +Instrument quokka Instrument lock #START SERVER CONFIGURATION SECTION @@ -19,7 +20,6 @@ source server_config.tcl fileeval $cfPath(velsel)/velsel.tcl fileeval $cfPath(motors)/motor_configuration.tcl -#fileeval gen_hipadaba.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl @@ -29,6 +29,29 @@ fileeval $cfPath(scan)/scan.tcl source $cfPath(hipadaba)/hipadaba_configuration.tcl source gumxml.tcl -MakeStateMon +#::histogram_memory::setmode pulser +#::histogram_memory::setmode calibration +::histogram_memory::setmode normal +#::histogram_memory::hmm_initialize +::histogram_memory::hmm_setup transparent 0 3 oat_nyc_eff oat_nxc_eff oat_ntc_eff +hmm_start 0 +MakeStateMon hmscan + +proc instrument_set_sobj_attributes {} { + + motor_set_sobj_attributes + ::utility::set_motor_attributes + ::utility::set_histomem_attributes + ::utility::set_sobj_attributes + ::counter::set_sobj_attributes + ::nexus::set_sobj_attributes + ::histogram_memory::set_sobj_attributes +## TODO move the following to the new ansto gumxml.tcl + sicslist setatt getgumtreexml privilege internal +} + +instrument_set_sobj_attributes +buildHDB instrument_dictionary +#buildHDB [instname]_dictionary fileeval extraconfig.tcl diff --git a/site_ansto/instrument/server_config.tcl b/site_ansto/instrument/server_config.tcl index b7031faf..3dccc837 100644 --- a/site_ansto/instrument/server_config.tcl +++ b/site_ansto/instrument/server_config.tcl @@ -1,9 +1,9 @@ # SICS common configuration -# $Revision: 1.26 $ -# $Date: 2007-07-09 05:25:57 $ +# $Revision: 1.27 $ +# $Date: 2007-07-22 05:23:40 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by $Author: dcl $ +# Last revision by $Author: ffr $ #set sicsroot /usr/local/sics set sicsroot ../ @@ -11,9 +11,9 @@ set cfParent config array set cfPath [list\ motors $cfParent/motors\ counter $cfParent/counter\ +chopper $cfParent/chopper\ hmm $cfParent/hmm\ scan $cfParent/scan\ -chopper $cfParent/chopper\ velsel $cfParent/velsel\ nexus $cfParent/nexus\ hipadaba $cfParent/hipadaba\ @@ -43,54 +43,53 @@ SicsUser spy 007 3 MakeDataNumber SicsDataNumber $sicsroot/data/DataNumber #Instrument specific configs must set the Instrument variable -VarMake SicsDataPrefix Text Internal +::utility::mkVar SicsDataPrefix Text internal SicsDataPrefix [SplitReply [Instrument]] SicsDataPrefix lock -VarMake sics_release Text Internal +::utility::mkVar SicsDataSuffix Text manager +SicsDataSuffix nx.hdf + + +::utility::mkVar sics_release Text internal set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}] sics_release [lindex $tmpstr [expr [llength $tmpstr] - 1]] sics_release lock -VarMake sics_revision_num Text Internal -set tmpstr [string map {"$" ""} {$Revision: 1.26 $}] +::utility::mkVar sics_revision_num Text internal +set tmpstr [string map {"$" ""} {$Revision: 1.27 $}] sics_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]] sics_revision_num lock -VarMake SicsDataPath Text Internal +::utility::mkVar SicsDataPath Text internal SicsDataPath $sicsroot/data/ SicsDataPath lock -VarMake SicsDataPostFix Text User -#SicsDataPostFix .hdf -#SicsDataPostFix lock -VarMake Title Text User -VarMake Sample Text User -VarMake User Text User -VarMake Email Text User -VarMake Phone Text User -VarMake starttime Text User -VarMake currentfile Text User -VarMake batchroot Text User +::utility::mkVar Title Text user title true experiment true true +::utility::mkVar Sample Text user description true sample true true +::utility::mkVar User Text user user true user true true +::utility::mkVar Email Text user email true user true true +::utility::mkVar Phone Text user phone true user true true +::utility::mkVar starttime Text user start true experiment true true MakeDrive exe batchpath ../batch exe syspath ../batch -VarMake detector_type Text Internal -VarMake detector_description Text Internal +::utility::mkVar detector_type Text internal +::utility::mkVar detector_description Text internal -VarMake dataFileName Text User +::utility::mkVar dataFileName Text user datafile true experiment true true -VarMake hmm_simulation Text Internal +::utility::mkVar hmm_simulation Text internal hmm_simulation false -VarMake counter_simulation Text Internal +::utility::mkVar counter_simulation Text internal counter_simulation false -VarMake motor_simulation Text Internal +::utility::mkVar motor_simulation Text internal motor_simulation false -VarMake sics_simulation Text Internal +::utility::mkVar sics_simulation Text internal sics_simulation false if {[SplitReply [sics_simulation]] == "true"} { @@ -98,3 +97,27 @@ if {[SplitReply [sics_simulation]] == "true"} { counter_simulation true motor_simulation true } + +proc server_set_sobj_attributes {} { +# set_sicsobj_atts sobj klass group name control data +#set_sicsobj_atts Title experiment @none title true true; +#set_sicsobj_atts Sample experiment user sample true true; +#set_sicsobj_atts User experiment user name true true; +#set_sicsobj_atts Email experiment user email true true; +#set_sicsobj_atts Phone experiment user phone true true; +#set_sicsobj_atts starttime experiment user start true true; +#set_sicsobj_atts dataFileName experiment @none datafile true true; + +#sicslist setatt SicsDataPrefix privilege internal +#sicslist setatt sics_release privilege internal +#sicslist setatt sics_revision_num privilege internal +#sicslist setatt SicsDataPath privilege internal +#sicslist setatt detector_type privilege internal +#sicslist setatt detector_description privilege internal +#sicslist setatt hmm_simulation privilege internal +#sicslist setatt counter_simulation privilege internal +#sicslist setatt motor_simulation privilege internal +#sicslist setatt sics_simulation privilege internal +} + +server_set_sobj_attributes diff --git a/site_ansto/instrument/util/command.tcl b/site_ansto/instrument/util/command.tcl new file mode 100644 index 00000000..7e2a47e9 --- /dev/null +++ b/site_ansto/instrument/util/command.tcl @@ -0,0 +1,139 @@ +set cmd_prop_list {kind command data false control true klass command nxsave false} +set cmd_par_prop_list {kind hobj data false control true nxsave false klass command} + +#Useful for selecting arguments passed to a mapped function + +# type = one of hipadaba types +# range restricts type values, maps to the argtype hlist property +# command {type:range p1 type:range p2} { ... } +proc command {acmdName arglist body} { + global cmd_prop_list cmd_par_prop_list + set NS [uplevel namespace current] + set cmdName ${NS}::$acmdName + variable ${cmdName}_param_list + variable ${cmdName}_feedback_list + if {[info exists ${cmdName}_param_list]} { + unset ${cmdName}_param_list + } + if {[info exists ${cmdName}_feedback_list]} { + unset ${cmdName}_feedback_list + } + # puts "cmdName: $cmdName" + foreach {type_spec var} $arglist { + lappend params $var + foreach {type domain} [split $type_spec :] {} + lappend ${cmdName}_param_list $var ${cmdName}_par_$var + set sicsvar [lindex [set ${cmdName}_param_list] end] + # Make var with priv=user so we can use sicslist on it + VarMake $sicsvar $type user + # Set privilege internal to stop hdb builder adding it to hdb tree + sicslist setatt $sicsvar privilege internal + #FIXME Can argtype be replace with 'domain' then we setatt domain $domain + if {$domain == ""} { + sicslist setatt $sicsvar argtype $type + } else { + if {$type == "text"} { + if {[string first , $domain] == -1} { + sicslist setatt $sicsvar argtype $domain + } else { + sicslist setatt $sicsvar argtype $type + sicslist setatt $sicsvar values $domain + } + } else { + sicslist setatt $sicsvar argtype $type + foreach {min max} [split $domain ,] {} + sicslist setatt $sicsvar min $min + sicslist setatt $sicsvar max $max + } + } + sicslist setatt $sicsvar long_name $var + foreach {att val} $cmd_par_prop_list { + sicslist setatt $sicsvar $att $val + } + } + set options { + set __cmdinfo [info level 0] + set __cmd [lindex $__cmdinfo 0] + variable ${__cmd}_param_list + switch -- [lindex $args 0] { + -map { + switch [lindex $args 1] { + "param" { + foreach {__var __param} [set ${__cmd}_param_list] { + eval [lindex $args 2] [lrange $args 3 end] $__param $__var + } + return + } + "feedback" { + if {[info exists ${__cmd}_feedback_list] != 1} { + return + } + foreach {__var __fbvar} [set ${__cmd}_feedback_list] { + eval [lindex $args 2] [lrange $args 3 end] $__fbvar $__var + } + return + } + } + } + -list { + switch [lindex $args 1] { + "param" { + return [set ${__cmd}_param_list] + } + "feedback" { + return [set ${__cmd}_feedback_list] + } + } + } + -set { + if {[lindex $args 1] == "feedback"} { + set __vname [lindex $args 2] + set __ptype fb + if {[llength $args] > 3} { + set __val [lindex $args 3] + } + } else { + set __vname [lindex $args 1] + set __ptype par + if {[llength $args] > 2} { + set __val [lindex $args 2] + } + } + if {[llength [sicslist ${__cmd}_${__ptype}_${__vname}]] == 0} { + error_msg "${__cmd}_${__ptype}_${__vname} doesnt exist" + return + } + if {[info exists __val]} { + ${__cmd}_${__ptype}_${__vname} $__val + return + } else { + return [SplitReply [${__cmd}_${__ptype}_${__vname}]] + } + } + -addfb { + foreach {__type __var} [lrange $args 1 end] { + set __sicsvar ${__cmd}_fb_${__var} + VarMake $__sicsvar $__type user + sicslist setatt $__sicsvar privilege internal + sicslist setatt $__sicsvar control true + sicslist setatt $__sicsvar data false + sicslist setatt $__sicsvar nxsave false + sicslist setatt $__sicsvar klass @none + lappend ${__cmd}_feedback_list $__var $__sicsvar + } + return + } + } + } + # The foreach loop initialises the parameters for the command body + # The 'if' statement makes sure that the SICS 'parameter' variables are only + # updated if they change. + proc $cmdName {args} [subst -nocommands {$options foreach n {$params} v \$args {set \$n \$v; if {\$v != [SplitReply [${cmdName}_par_\$n]]} {debug_msg "set ${cmdName}_par_\$n \$v"; ${cmdName}_par_\$n \$v}}; $body }] + publish $cmdName user + sicslist setatt $cmdName long_name $acmdName + sicslist setatt $cmdName privilege user + sicslist setatt $cmdName group [string map {:: ""} $NS] + foreach {att val} $cmd_prop_list { + sicslist setatt $cmdName $att $val + } +} diff --git a/site_ansto/instrument/util/extra_utility.tcl b/site_ansto/instrument/util/extra_utility.tcl new file mode 100644 index 00000000..822e5efa --- /dev/null +++ b/site_ansto/instrument/util/extra_utility.tcl @@ -0,0 +1,107 @@ +# Many of these functions are also useful in test and debug code +# running on an external Tcl interpreter. + +# LIST FUNCTIONS +proc head {args} {lindex [join $args] 0} +proc tail {args} {join [lrange [join $args] 1 end]} + +# SET FUNCTIONS + +# Set membership +proc setmem {el A} { + expr {[lsearch $A $el] >= 0} +} + +# Set difference: A\B, members of A that are not in B +proc setdiff {A B} { + foreach el $A { + if {[lsearch -exact $B $el] == -1} { + lappend missing $el; + } + } + if {[info exists missing]} { + return $missing; + } +} + +proc _intersection {lista listb} { + set result {} + foreach elem [join $listb] { + if { [lsearch -exact $lista $elem] != -1 } { + lappend result $elem + } + } + return $result +} + +proc intersection {lista args} { + if {[llength $args] == 0} {return $lista} + if {[llength $args] == 1} {return [_intersection $lista $args]} + return [intersection [_intersection $lista [head $args]] [tail $args]]; +} + + +# TYPE CHECKING +# This is an enhanced set membership function. +# It can check that an element is a member of a list or +# of a named type +proc isoneof {element setb} { + global simpleType; + set result 0; + + foreach elb $setb { + switch $elb { + alpha {set result [string is alpha $element]} + text {set result [string is wordchar $element]} + print {set result [string is print $element]} + float {set result [string is double $element]} + int {set result [string is integer $element]} + default {set result [expr {$element == $elb}]} + } + if {$result == 1} {return 1} + } + return 0; +} + +# Returns 'sicslist' output in lower case, this may be useful in macros. +# This function is used a lot in the hdbbuilder +proc tolower_sicslist {args} { + set result [eval sicslist $args] + return [string tolower $result]; +} + +# You can use debug_msg in place of 'puts' for debug info in Tcl macros. +# debug on, turns on debugging +# debug off, turns off debugging +proc debug_mode {mode} { + switch $mode { + on { + proc debug_msg {args} { + set cmdinfo [info level -1] + set cmd [lindex $cmdinfo 0] + set arglist [lrange $cmdinfo 1 end] + clientput "DEBUG:$args> [namespace origin $cmd] $arglist" + } + } + off { + proc debug_msg {args} {}; + } + } +} +proc debug_msg {args} {}; +publish debug_mode mugger +sicslist setatt debug_mode privilege internal + +proc todo_msg {args} { + set cmdinfo [info level -1] + set cmd [lindex $cmdinfo 0] + set arglist [lrange $cmdinfo 1 end] + clientput "TODO:$args> [namespace origin $cmd] $arglist" +} + +proc error_msg {args} { + set cmdinfo [info level -1] + set cmd [lindex $cmdinfo 0] + set arglist [lrange $cmdinfo 1 end] + clientput "ERROR: [namespace origin $cmd] $arglist: $args" error +} diff --git a/site_ansto/instrument/util/utility.tcl b/site_ansto/instrument/util/utility.tcl index 7c520414..8b2de0ee 100644 --- a/site_ansto/instrument/util/utility.tcl +++ b/site_ansto/instrument/util/utility.tcl @@ -1,10 +1,18 @@ # Some useful functions for SICS configuration. -# $Revision: 1.3 $ -# $Date: 2007-04-20 01:53:31 $ +# $Revision: 1.4 $ +# $Date: 2007-07-22 05:23:41 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by $Author: ffr $ +source util/extra_utility.tcl +source util/command.tcl + +# Returns attribute name and value +proc getatt {sicsobj att} { + lindex [split [tolower_sicslist $sicsobj $att] =] 1 +} + # Utility fucntion for setting the home and upper and lower # limits for a motor proc setHomeandRange {args} { @@ -47,8 +55,6 @@ proc setpos {motor pos} { set newZero [expr $currPos - $pos + $oldZero] uplevel #0 "$motor softzero $newZero" } -publish setpos user -publish SplitReply user proc getinfo {object} { set wc [format "%s_*" $object]; @@ -59,4 +65,152 @@ proc getinfo {object} { } } } -publish getinfo spy + + +# Convenience function for setting klass group and name attributes +# on sics object metadata +proc set_sicsobj_atts {sobj aklass agroup aname acontrol adata} { + sicslist setatt $sobj klass $aklass; + if {$agroup != "@none"} { + sicslist setatt $sobj group $agroup; + } + sicslist setatt $sobj long_name $aname; + sicslist setatt $sobj control $acontrol; + sicslist setatt $sobj data $adata; +} + +## TODO put all the utility macros in the utility namespace +namespace eval utility { + namespace export instname; + variable instrument_name; + set instrument_name ""; + +# Convenience command for getting unadorned instrument name + proc instname {} { + variable instrument_name; + set instrument_name [SplitReply [instrument]]; + proc ::utility::instname {} { + variable instrument_name; + return $instrument_name; + } + return $instrument_name; + } + +# Initialise the attributes of sobj +# to make it ready for adding to the hdb tree. +proc mkData {sobj name aklass args} { + sicslist setatt $sobj long_name $name + sicslist setatt $sobj nxalias $sobj + sicslist setatt $sobj klass $aklass + switch [getatt $sobj type] { + "sicsvariable" { + sicslist setatt $sobj kind hobj + sicslist setatt $sobj data true + sicslist setatt $sobj control true + sicslist setatt $sobj nxsave true + sicslist setatt $sobj privilege internal + sicslist setatt $sobj mutable false + } + default { + error "ERROR [info level -1] -> [info level 0]" + } + } + array set attval $args + foreach att {kind data control nxsave privilege nxalias mutable} { + if {[info exists attval($att)]} { + sicslist setatt $sobj $att $attval($att) + } + } +} +# Sets the privilege attribute when making a SICS variable +# access = spy, user, manager, internal, readonly + proc mkVar {name type access {along_name x} {anxsave x} {aklass x} {acontrol x} {adata x}} { + array set sicsAccess {spy spy user user manager mugger internal internal readonly internal} + VarMake $name $type $sicsAccess($access); + sicslist setatt $name privilege $access; + sicslist setatt $name kind hobj; + sicslist setatt $name mutable false + if {$access != "internal"} { + sicslist setatt $name data $adata + sicslist setatt $name control $acontrol + sicslist setatt $name nxsave $anxsave + sicslist setatt $name klass $aklass + sicslist setatt $name long_name $along_name + } + } + + proc about {option args} { + return [info $option $args]; + } +} + +namespace import ::utility::*; +Publish getinfo spy +Publish setpos user +Publish SplitReply user +Publish instname user + +proc debug {args} { + clientput $args +} +proc echo {args} { + clientput $args +} + +proc ::utility::set_sobj_attributes {} { + sicslist setatt getinfo privilege internal + sicslist setatt setpos privilege internal + sicslist setatt SplitReply privilege internal + sicslist setatt instname privilege internal +} + +proc ::utility::set_histomem_attributes {} { + foreach hm [sicslist type histmem] { + sicslist setatt $hm nxalias $hm + sicslist setatt $hm mutable true + } +} +proc ::utility::set_motor_attributes {} { +# Bug: SICS-57 on Jira +# The first entry in [sicslist type motor] is 'motor' when +# we run the sicslist command on initialisation. This is because +# The 'Motor' command has type motor, so we skip it with lrange. + foreach m [lrange [sicslist type motor] 1 end] { + sicslist setatt $m kind hobj + sicslist setatt $m data true + sicslist setatt $m control true + sicslist setatt $m nxsave true + sicslist setatt $m mutable true + sicslist setatt $m units [SplitReply [$m units]] + sicslist setatt $m long_name [SplitReply [$m long_name]] + set mpart [split [SplitReply [$m part] ] .] + sicslist setatt $m klass [lindex $mpart 0] + if {[llength $mpart] == 2} { + sicslist setatt $m group [lindex $mpart 1] + } + sicslist setatt $m nxalias $m + switch [expr int([SplitReply [$m accesscode]])] { + 0 {sicslist setatt $m privilege internal} + 1 {sicslist setatt $m privilege manager} + 2 {sicslist setatt $m privilege user} + 3 {sicslist setatt $m privilege spy} + } + } + foreach m [sicslist type configurablevirtualmotor] { + sicslist setatt $m kind hobj + sicslist setatt $m data true + sicslist setatt $m control true + sicslist setatt $m nxsave true + sicslist setatt $m privilege user + sicslist setatt $m nxalias $m + sicslist setatt $m mutable true + } +} + +# Retuns plain value of hdb node property +proc ::utility::hgetplainprop {hpath prop} { + return [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ] +} +proc ::utility::hlistplainprop {hpath} { + return [string trim [join [split [hlistprop $hpath] =] ]] +}