linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merged new hdb and nexus code.

Browse Source 
r2099 | ffr | 2007-07-22 15:23:41 +1000 (Sun, 22 Jul 2007) | 2 lines
This commit is contained in:
Ferdi Franceschini
2007-07-22 15:23:41 +10:00
committed by Douglas Clowes
parent 4e407d0a73
commit 8770acc191
37 changed files with 2404 additions and 645 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
site_ansto/instrument/config/counter/counter_common_1.tcl
View File

@@ -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
}

102
site_ansto/instrument/config/hipadaba/common_hipadaba_configuration.tcl
View File

@@ -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;

108
site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl Normal file
View File

@@ -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}
}
}]

434
site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl Normal file
View File

@@ -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
View 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}}]
}
}
}]
}

22
site_ansto/instrument/config/hmm/anstohm_linked.xml Normal file
View File

@@ -0,0 +1,22 @@
<?xml version = '1.0' encoding = 'UTF-8'?>
<!-- Revised version MJL 2/07 -->
<anstohm:anstohm filler="ansto1" >
<config_links>
<config_link filename="../HMconfig/Default/Server_defaults.xml" />
<config_link filename="../HMconfig/Default/[inst_defaults].xml" />
</config_links>
<config_fillers>
<config_filler instrument="[instname]">
<!-- Place your customizations of the default configuration in this section -->
<!-- (if any) in config_server or config_fillers sections here. -->
<!-- These will override the linked configuration data above. -->
[BAT_TABLE]
[CAT_TABLE]
[FAT_TABLE]
[NAT_TABLE]
[OAT_TABLE]
[SAT_TABLE]
[SRV_TABLE]
</config_filler>
</config_fillers>
</anstohm:anstohm>

443
site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl
View File

@@ -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 <n>
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 <n>
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) "<FAT\n"
foreach att {SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE} {
if {[info exists param($att)]} {
append hmm_xml(FAT_TABLE) "$att=\"$param($att)\"\n"
}
}
append hmm_xml(FAT_TABLE) "></FAT>"
}
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) {
<OAT NO_OAT_X_CHANNELS=\"$NOXCH\" NO_OAT_Y_CHANNELS=\"$NOYCH\" NO_OAT_T_CHANNELS=\"$NOTCH\">
$XTAG
$YTAG
$TTAG
</OAT>
}
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)</$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
}

2
site_ansto/instrument/config/nexus/nexus_in_hmm_common_1.dic
View File

@@ -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)}

1
site_ansto/instrument/config/nexus/nexus_in_scan_common_1.dic
View File

@@ -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

475
site_ansto/instrument/config/nexus/nxscripts_common_1.tcl
View File

@@ -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

348
site_ansto/instrument/config/scan/scan_common_1.tcl
View File

@@ -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