Merged new hdb and nexus code.
r2099 | ffr | 2007-07-22 15:23:41 +1000 (Sun, 22 Jul 2007) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
4e407d0a73
commit
8770acc191
@@ -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;
|
||||
@@ -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}
|
||||
}
|
||||
}]
|
||||
@@ -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 <sicsobj>
|
||||
# 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 <hpath> <sobjtype>
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
130
site_ansto/instrument/config/hipadaba/instdict_specification.tcl
Normal file
130
site_ansto/instrument/config/hipadaba/instdict_specification.tcl
Normal file
@@ -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 <sobj>] 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}}]
|
||||
}
|
||||
}
|
||||
}]
|
||||
}
|
||||
Reference in New Issue
Block a user