4f3fb5e250
Create object when in simulation mode nxscripts_common_1.tcl Set units attributes on script context objects data sans aperture_configuration.tcl Update rotary attenuator lookup table. Set parameters when motors positions are within tolerance of the lookup table positions. sans, parameters.tcl sct_velsel.tcl Set units and update parameter names to be consistent quokka_configuration.tcl Add convenience command to load environment controllers. server_config.tcl Make sure that controllers are properly generated when loading them from the ext raconfig.tcl. r2881 | ffr | 2010-01-29 16:50:51 +1100 (Fri, 29 Jan 2010) | 20 lines
1371 lines
46 KiB
Tcl
1371 lines
46 KiB
Tcl
##
|
|
# @file nxscripts_common_1.tcl
|
|
# @brief Defines functions to create and save a nexus datafile based on the hdb tree metadata
|
|
#
|
|
|
|
MakeNXScript
|
|
sicsdatafactory new nxscript_data
|
|
#mkVar name type access long_name nxsave klass control data
|
|
::utility::mkVar estart Text user start_time true entry false true
|
|
::utility::mkVar eend Text user end_time true entry false true
|
|
::utility::mkVar timestamp int user time_stamp true entry false true
|
|
::utility::mkVar data_run_number int user run_number true instrument false true
|
|
::utility::mkVar save_count int user save_count true experiment true true
|
|
::utility::mkVar currpoint int user currpoint true experiment true true
|
|
::utility::mkVar nexus_datatype text user DataType true data false true
|
|
::utility::mkVar file_status text user file_status true experiment true true
|
|
::utility::mkVar file_set_list Text user file_set true experiment true true
|
|
sicslist setatt data_run_number mutable true
|
|
sicslist setatt timestamp mutable true
|
|
sicslist setatt timestamp units seconds
|
|
sicslist setatt nexus_datatype mutable false
|
|
|
|
namespace eval nexus {
|
|
nexus_datatype "UNKNOWN"
|
|
set exports [list newfile closefile save data newfile_collection save_collection]
|
|
eval namespace export $exports
|
|
if 0 {datafilename}
|
|
|
|
variable filetypes
|
|
set filetypes [list BEAM_MONITOR HISTOPERIOD_XYT TOTAL_HISTOGRAM_XY TOTAL_HISTOGRAM_XT TOTAL_HISTOGRAM_YT TOTAL_HISTOGRAM_X TOTAL_HISTOGRAM_Y TOTAL_HISTOGRAM_T ]
|
|
|
|
##
|
|
# @brief This is the nexus dictionary generated by the gen_nxdict function
|
|
variable nxdictionary
|
|
##
|
|
# @brief Records the current Nexus file state.
|
|
variable state
|
|
##
|
|
# @brief Sets the default naming convention for the NXentry group.
|
|
variable NXentry_nm_convention
|
|
array set NXentry_nm_convention {
|
|
"echidna" "simple"
|
|
"wombat" "simple"
|
|
"kowari" "simple"
|
|
"quokka" "fname"
|
|
"platypus" "simple"
|
|
}
|
|
}
|
|
namespace eval ::nexus::histmem {}
|
|
namespace eval ::nexus::motor {}
|
|
namespace eval ::nexus::environment_controller {}
|
|
namespace eval ::nexus::sicsvariable {}
|
|
namespace eval ::nexus::singlecounter {}
|
|
namespace eval ::nexus::script {}
|
|
namespace eval ::histogram_memory {
|
|
variable histmem_axes
|
|
array set histmem_axes {
|
|
TOF /instrument/detector/time
|
|
HOR /instrument/detector/x_pixel_offset
|
|
VER /instrument/detector/y_pixel_offset
|
|
PER /instrument/run_number
|
|
SVAR /instrument/run_number
|
|
}
|
|
}
|
|
|
|
|
|
##
|
|
# @brief Strips the output of a SICS command leaving only the value\n
|
|
# TODO Replace $cmd_output with [$cmd_output] so we can just pass the command name
|
|
#
|
|
# @param cmd_output The output from a command substitution
|
|
# @return The unadorned value returned by the SICS command which produced cmd_output
|
|
proc getVal {cmd_output} {
|
|
return [string trim [lindex [split $cmd_output =] 1 ] ]
|
|
}
|
|
|
|
proc ::nexus::datapath {} {
|
|
return [SplitReply [sicsdatapath]]
|
|
}
|
|
##
|
|
# @brief Generate a filename from sicsdatanumber and sicsdatapath
|
|
#
|
|
# @param postfix This is the filename suffix, must be one of: nx.hdf, hdf, h5, nx5, xml
|
|
proc newFileName {idNum postfix} {
|
|
if [ catch {
|
|
array set inst_mnem {quokka QKK wombat WBT echidna ECH kowari KWR koala KOL taipan TPN platypus PLP pelican PLN}
|
|
# set prefix [SplitReply [sicsdataprefix]]
|
|
set date_time_arr [split [sicstime] " "]
|
|
set isodate [lindex $date_time_arr 0]
|
|
set isotime [string map {: -} [lindex $date_time_arr 1]]
|
|
set fmtStr [format "%s/%s%07d.%s" [::nexus::datapath] $inst_mnem([instname]) $idNum $postfix]
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $fmtStr
|
|
}
|
|
|
|
proc ::nexus::process_filetype_policy {filetype} {
|
|
if [ catch {
|
|
if {$filetype == "BEAM_MONITOR"} {
|
|
::hdb::set_save / true
|
|
::hdb::set_save $::histogram_memory::HP_HMM false
|
|
set ::counter::HP_BM [getatt monitor_counts hdb_path]
|
|
hsetprop $::counter::HP_BM link data_set
|
|
hsetprop $::counter::HP_BM @signal 1
|
|
} else {
|
|
::hdb::set_save / true
|
|
hsetprop $::histogram_memory::HP_HMM datatype_savelist $filetype
|
|
hsetprop $::histogram_memory::HP_HMM link data_set
|
|
::histogram_memory::set_axes $filetype
|
|
}
|
|
foreach sobj [sicslist link data_set] {
|
|
hsetprop [getatt $sobj hdb_path] link data_set
|
|
}
|
|
foreach sobj [sicslist link parameters_group] {
|
|
hsetprop [getatt $sobj hdb_path] link parameters_group
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
|
|
##
|
|
# @brief Initialise state variables
|
|
proc ::nexus::init {} {
|
|
variable state
|
|
variable nexusdic
|
|
variable currFilename
|
|
variable isNewFile
|
|
variable save_count_arr
|
|
variable start_seconds_array
|
|
variable file_states
|
|
|
|
array set state {
|
|
file,open "false"
|
|
file,namestyle "data"
|
|
file,format "hdf"
|
|
file,fileset "false"
|
|
file,incr_datnum "false"
|
|
file,labels @singlefile
|
|
}
|
|
|
|
set nexusdic "nexus.dic"
|
|
array set currFilename ""
|
|
array set isNewFile ""
|
|
array set save_count_arr ""
|
|
array set start_seconds_array ""
|
|
array set file_states {U "UNKNOWN" O "OPEN" C "CLOSED" S "SAVING"}
|
|
save_count 0
|
|
currpoint 0
|
|
file_status UNKNOWN
|
|
}
|
|
|
|
proc ::nexus::ic_initialize {} {
|
|
}
|
|
|
|
proc getBaseName {fileName} {
|
|
set baseName [lindex [split [file tail $fileName] "."] 0]
|
|
return $baseName
|
|
}
|
|
##
|
|
# @brief Create a nexus file
|
|
# This first generates a nexus dictionary file from the hdb tree and then creates a new
|
|
# nexus file based on that dictionary.
|
|
proc ::nexus::createfile {FileName} {
|
|
variable nexusdic
|
|
variable state
|
|
|
|
if [ catch {
|
|
if {$state(file,open) == "true"} {
|
|
error "Can't create a new file because the current file is still open"
|
|
}
|
|
switch $state(file,format) {
|
|
"hdf" {set create_type create5}
|
|
"xml" {set create_type createxml}
|
|
default {
|
|
error "ERROR: Invalid file format $state(file,format)"
|
|
}
|
|
}
|
|
|
|
set nxdict_path [::nexus::gen_nxdict $nexusdic]
|
|
if {$state(file,incr_datnum) == true} {
|
|
sicsdatanumber incr
|
|
}
|
|
if [catch {nxscript $create_type $FileName $nxdict_path} message] {
|
|
killfile
|
|
error $message
|
|
}
|
|
set state(file,open) false
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Checks if the given file type is defined.
|
|
#
|
|
# @return 1 on success, 0 on failure
|
|
proc ::nexus::isValidFileType {type} {
|
|
variable filetypes
|
|
if {[lsearch $filetypes $type] == -1} {
|
|
return 0
|
|
} else {
|
|
return 1
|
|
}
|
|
}
|
|
##
|
|
# @brief Setup file state info for writing a new file.
|
|
#
|
|
# @type data file type as defined in config/nexus/datafiletype.tcl or clear
|
|
# @param namestyle scratch or data, default=data\n
|
|
# If namestyle=data, the save command will create numbered files using the ANSTO
|
|
# file naming convention.\n
|
|
# If namestyle=scratch, the save command will create scratch files.
|
|
#
|
|
# postconditions:
|
|
# state(file,open) true
|
|
# /data/currentfiletype == UNKNOWN
|
|
proc ::nexus::newfile {type {namestyle data}} {
|
|
::nexus::newfile_collection -filetype $type -savetype $namestyle
|
|
}
|
|
|
|
##
|
|
# @brief Returns a list of paths matching the given property
|
|
#
|
|
# @param hpath, subtree path to search
|
|
# @param prop, name of property, can be 'abc*' but not 'a*c'
|
|
proc ::nexus::findHdbProps {hpath prop} {
|
|
if [ catch {
|
|
set hpList ""
|
|
foreach hp [hlist $hpath] {
|
|
if {$hpath == "/"} {
|
|
set subList [::nexus::findHdbProps /$hp $prop]
|
|
} else {
|
|
set subList [::nexus::findHdbProps $hpath/$hp $prop]
|
|
}
|
|
if {[llength $subList] > 0} {
|
|
lappend hpList [join $subList]
|
|
}
|
|
}
|
|
if {[string length [hfindprop $hpath $prop]] > 0 } {
|
|
lappend hpList $hpath
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return [join $hpList]
|
|
}
|
|
|
|
##
|
|
# @brief Let's make a collection of files (ie a file-set) or just one.
|
|
#
|
|
# @param -labels L or {L1 L2 ..}, optional. A list of labels which identify a file-set
|
|
# If you don't specify a list of labels then only one file is created
|
|
proc ::nexus::newfile_collection {args} {
|
|
variable state
|
|
variable currFilename
|
|
variable isNewFile
|
|
variable save_count_arr
|
|
variable file_states
|
|
|
|
set valid_options [list "-labels" "-filetype" "-savetype"]
|
|
set required_options [list "-filetype" "-savetype"]
|
|
if [ catch {
|
|
::utility::check_valid_options $args $valid_options
|
|
::utility::check_required_options $args $required_options
|
|
array set param $args
|
|
set file_suffix [SplitReply [SicsDataPostFix]]
|
|
switch $file_suffix {
|
|
hdf - nx.hdf - h5 - nx5 {set state(file,format) hdf}
|
|
xml {set state(file,format) xml}
|
|
default { error "ERROR: Invalid file suffix $file_suffix" }
|
|
}
|
|
set state(file,namestyle) $param(-savetype)
|
|
array unset save_count_arr
|
|
array unset currFilename
|
|
array unset isNewFile
|
|
if {$param(-savetype) == "scratch"} {
|
|
set state(file,incr_datnum) false
|
|
} else {
|
|
set state(file,incr_datnum) true
|
|
}
|
|
set idNum [expr 1 + [SplitReply [sicsdatanumber]]]
|
|
if [info exists param(-labels)] {
|
|
set state(file,fileset) "true"
|
|
set state(file,labels) $param(-labels)
|
|
if {$param(-savetype) == "scratch"} {
|
|
foreach fid $state(file,labels) {
|
|
set save_count_arr($fid) 0
|
|
set isNewFile($fid) "true"
|
|
set currFilename($fid) [format "%s/scratch_%s.%s" [::nexus::datapath] $fid $file_suffix]
|
|
lappend files $currFilename($fid)
|
|
}
|
|
} else {
|
|
foreach fid $state(file,labels) {
|
|
set save_count_arr($fid) 0
|
|
set isNewFile($fid) "true"
|
|
set currFilename($fid) [newFileName $idNum $file_suffix]
|
|
incr idNum
|
|
lappend files $currFilename($fid)
|
|
}
|
|
}
|
|
file_set_list [join $files ,]
|
|
} else {
|
|
set state(file,fileset) "false"
|
|
set state(file,labels) @singlefile
|
|
set save_count_arr(@singlefile) 0
|
|
set isNewFile(@singlefile) "true"
|
|
if {$param(-savetype) == "scratch"} {
|
|
set currFilename(@singlefile) [format "%s/scratch.%s" [::nexus::datapath] $file_suffix]
|
|
} else {
|
|
set currFilename(@singlefile) [newFileName $idNum $file_suffix]
|
|
}
|
|
}
|
|
save_count 0
|
|
currpoint 0
|
|
file_status $file_states(U)
|
|
if {$param(-filetype) == "clear"} {
|
|
::hdb::set_save / false
|
|
nexus_datatype "UNKNOWN"
|
|
file_set_list "UNKNOWN"
|
|
# dataFileName "UNKNOWN"
|
|
} else {
|
|
foreach hp [split [::nexus::findHdbProps / link]] {
|
|
hdelprop $hp link
|
|
}
|
|
foreach hp [::nexus::findHdbProps / @*] {
|
|
foreach {pname pval} [hfindprop $hp @*] {
|
|
hdelprop $hp $pname
|
|
}
|
|
}
|
|
::nexus::process_filetype_policy $param(-filetype)
|
|
nexus_datatype $param(-filetype)
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
} else {
|
|
return OK
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Save data to the currently open file and then close it.
|
|
#
|
|
# @param point This is the array index for mutable data elements
|
|
#
|
|
# This function provides the top level call to the recursive ::nexus::savetree
|
|
# function, it should only be called by the ::nexus::save command.
|
|
#
|
|
# @see ::nexus::savetree
|
|
# @see ::nexus::save
|
|
proc ::nexus::save_data {point filestatus} {
|
|
set valid_caller "::nexus::save_collection"
|
|
|
|
debug_msg "save point $point in [dataFileName]"
|
|
if [ catch {
|
|
set caught_exception false
|
|
if {[info level]<2} {
|
|
error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
|
|
}
|
|
set caller [namespace origin [lindex [info level -1] 0]]
|
|
if {$caller != $valid_caller} {
|
|
error "ERROR: [lindex [info level 0] 0] can only be called via the $valid_caller command, not by $caller"
|
|
}
|
|
} message ] {
|
|
set caught_exception true
|
|
}
|
|
foreach child [hlist /] {
|
|
if [ catch {
|
|
if {[hpropexists /$child data] && [hgetpropval /$child data] == "true"} {
|
|
::nexus::savetree $child $point $filestatus
|
|
}
|
|
} message ] {
|
|
lappend msglst $message
|
|
set caught_exception true
|
|
}
|
|
}
|
|
if {$caught_exception} {
|
|
return -code error "([info level 0]) $msglst"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @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
|
|
#
|
|
# A new file will be created if the new file state has been set to true, or
|
|
# if the current data type doesn't match the current file type.
|
|
proc ::nexus::save {{point 0}} {
|
|
if [ catch {
|
|
::nexus::save_collection -index $point
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Save data in a file from a file-set
|
|
proc ::nexus::save_collection {args} {
|
|
variable state
|
|
variable start_seconds
|
|
variable start_seconds_array
|
|
variable currFilename
|
|
variable isNewFile
|
|
variable save_count_arr
|
|
variable file_states
|
|
|
|
set valid_options [list "-index" "-label"]
|
|
set required_options [list "-index"]
|
|
if [ catch {
|
|
set caught_exception false
|
|
::utility::check_valid_options $args $valid_options
|
|
::utility::check_required_options $args $required_options
|
|
array set param $args
|
|
set point $param(-index)
|
|
if {[string is integer $point] == 0} {
|
|
error_msg "save index must be an integer"
|
|
} elseif {$point < 0} {
|
|
error_msg "save index cannot be negative"
|
|
}
|
|
|
|
# ::data::gumtree_save -set run_number $point
|
|
data_run_number $point
|
|
|
|
if [info exists param(-label)] {
|
|
if {[lsearch -exact $state(file,labels) $param(-label)] == -1} {
|
|
error "ERROR: The label must be one of $state(file,labels)"
|
|
}
|
|
set data_label $param(-label)
|
|
} else {
|
|
if {$state(file,fileset) == "true"} {
|
|
error "ERROR: You must set -label when saving to a file-set"
|
|
}
|
|
set data_label @singlefile
|
|
}
|
|
if {$isNewFile($data_label)} {
|
|
set isNewFile($data_label) "false"
|
|
::nexus::createfile $currFilename($data_label)
|
|
dataFileName $currFilename($data_label)
|
|
estart [sicstime]
|
|
eend [sicstime]
|
|
array unset start_seconds_array
|
|
set start_seconds [clock seconds]
|
|
# set start_seconds_array($data_label) $start_seconds
|
|
timestamp 0
|
|
file_status $file_states(O)
|
|
::nexus::nxreopenfile $currFilename($data_label)
|
|
file_status $file_states(S)
|
|
set baseName [getBaseName $currFilename($data_label)]
|
|
set entryName [gen_NXentry_name $baseName]
|
|
nxscript updatedictvar pa_entryName $entryName
|
|
::nexus::save_data $point newfile
|
|
} else {
|
|
eend [sicstime]
|
|
# timestamp [expr {[clock seconds] - $start_seconds_array($data_label)}]
|
|
timestamp [expr {[clock seconds] - $start_seconds}]
|
|
dataFileName $currFilename($data_label)
|
|
file_status $file_states(O)
|
|
::nexus::nxreopenfile $currFilename($data_label)
|
|
file_status $file_states(S)
|
|
set baseName [getBaseName $currFilename($data_label)]
|
|
set entryName [gen_NXentry_name $baseName]
|
|
nxscript updatedictvar pa_entryName $entryName
|
|
::nexus::save_data $point oldfile
|
|
}
|
|
} message ] {
|
|
nxscript puttext data_save_error "([info level 0]) $message"
|
|
set caught_exception true
|
|
}
|
|
if {[info exists data_label] && [info exists currFilename($data_label)]} {
|
|
::nexus::nxclosefile $currFilename($data_label)
|
|
file_status $file_states(C)
|
|
incr save_count_arr($data_label)
|
|
save_count $save_count_arr($data_label)
|
|
currpoint $point
|
|
} else {
|
|
set message "$message !! FAILED ASSERTION: data_lable and/or currFilename undefined !!"
|
|
}
|
|
if {$caught_exception} {
|
|
return -code error "([info level 0]) $message"
|
|
} else {
|
|
return
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Reopen the current file, close it with nxclosefile
|
|
# this should only be called by the ::nexus::save command.
|
|
#
|
|
# @see nxclosefile
|
|
# @see ::nexus::save
|
|
proc ::nexus::nxreopenfile {filename} {
|
|
global cfPath
|
|
variable state
|
|
variable nexusdic
|
|
set valid_caller "::nexus::save_collection"
|
|
|
|
if [ catch {
|
|
if {[info level]<2} {
|
|
error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
|
|
}
|
|
set caller [namespace origin [lindex [info level -1] 0]]
|
|
if {$caller != $valid_caller} {
|
|
error "ERROR: [lindex [info level 0] 0] can only be called via the $valid_caller command, not by $caller"
|
|
}
|
|
if {$state(file,open) == "false"} {
|
|
nxscript reopen $filename $cfPath(nexus)/$nexusdic
|
|
set state(file,open) true
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Close the current file. You can reopen it with nxreopenfile
|
|
# this should only be called by the ::nexus::save command.
|
|
#
|
|
# @see nxreopenfile
|
|
# @see ::nexus::save
|
|
proc ::nexus::nxclosefile {filename} {
|
|
variable state
|
|
set valid_caller "::nexus::save_collection"
|
|
|
|
if [ catch {
|
|
if {[info level]<2} {
|
|
error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
|
|
}
|
|
set caller [namespace origin [lindex [info level -1] 0]]
|
|
if {$caller != $valid_caller} {
|
|
error "ERROR: [lindex [info level 0] 0] can only be called via the $valid_caller command, not by $caller"
|
|
}
|
|
if {$state(file,open) == "true"} {
|
|
nxscript close
|
|
set state(file,open) false
|
|
set flist [split $filename "/"]
|
|
set fname [lindex $flist [expr [llength $flist] - 1] ]
|
|
clientput "$fname updated" "event"
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
##
|
|
# @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 aux_data 1|2|3|4|5|6|7|8|9 datsource
|
|
# Records that /data/aux_datan should be linked to datsource
|
|
# data clear
|
|
# Clears all link targets and sets the data type identifier to unknown
|
|
# data alias <name>, remove alias <name>
|
|
# data alias <name> <target>, set <name> as an alias for <target> unless it has already been defined.
|
|
proc ::nexus::data {args} {
|
|
# TODO This is obsolete
|
|
}
|
|
proc ::nexus::data_junk {args} {
|
|
variable state
|
|
variable data_gp_path
|
|
|
|
if [ catch {
|
|
if {[llength $args] == 1} {
|
|
set arguments [lindex $args 0]
|
|
} else {
|
|
set arguments $args
|
|
}
|
|
|
|
set dpath $data_gp_path
|
|
set opt [lindex $arguments 0]
|
|
set arglist [lrange $arguments 1 end]
|
|
|
|
switch $opt {
|
|
"axis" - "aux_data" {
|
|
debug_msg "'axis' case of switch"
|
|
set link_target [lindex $arguments 2]
|
|
if {[getatt $link_target privilege] == "internal"} {
|
|
error "[info level 0], Cannot link $link_target because it doesn't have an hdb node."
|
|
}
|
|
set axnum [lindex $arguments 1]
|
|
if {[string is integer $axnum] == 0} {
|
|
error "ERROR: [info level -1]->data, index for data axis should be an integer, not $axnum"
|
|
}
|
|
if {[getatt $link_target type] == ""} {
|
|
error "Unknown link target $link_target"
|
|
}
|
|
set hp $dpath/${opt}_$axnum
|
|
# if {[::utility::hgetplainprop $hp link] == "@none"} {
|
|
# hsetprop $hp link [getatt [lindex $arguments 2] id]
|
|
hsetprop $hp long_name [getatt [lindex $arguments 2] long_name]
|
|
# }
|
|
}
|
|
"data_set" {
|
|
debug_msg "'data_set' case of switch"
|
|
set link_target [lindex $arguments 1]
|
|
if {[getatt $link_target type] == ""} {
|
|
error "Unknown link target $link_target"
|
|
}
|
|
hsetprop $dpath datatype [lindex [info level -1] 0]
|
|
set hp $dpath/data_set
|
|
# if {[::utility::hgetplainprop $hp link] == "@none"} {
|
|
# hsetprop $hp link [getatt $link_target id]
|
|
hsetprop $hp long_name [getatt $link_target long_name]
|
|
# }
|
|
}
|
|
"clear" {
|
|
debug_msg "'clear' case of switch"
|
|
foreach child [hlist $dpath] {
|
|
# hsetprop $dpath/$child link @none
|
|
hsetprop $dpath/$child long_name @none
|
|
}
|
|
}
|
|
"alias" {
|
|
debug_msg "'alias' case of switch"
|
|
set alias_name [lindex $arglist 0]
|
|
set alias_target [lindex $arglist 1]
|
|
switch $alias_target {
|
|
"" {
|
|
if {[info exists state(data,alias,$alias_name)]} {
|
|
definealias $alias_name
|
|
set state(data,alias,$alias_name) @none
|
|
}
|
|
}
|
|
default {
|
|
if {[info exists state(data,alias,$alias_name)]} {
|
|
if { $state(data,alias,$alias_name) == "@none" } {
|
|
definealias $alias_name $alias_target
|
|
}
|
|
} else {
|
|
definealias $alias_name $alias_target
|
|
}
|
|
}
|
|
}
|
|
}
|
|
default {error "ERROR: [info level -1]->data, Unsupported option $opt"}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
|
|
##
|
|
# @brief Traverse the hdb subtree from the given path and save the data in the currently open file
|
|
#
|
|
# @param hpath path of subtree to save, must not be "/"
|
|
# @param pt Current array index for mutable data (optional default=0)
|
|
proc ::nexus::savetree {hpath pt filestatus} {
|
|
set caught_exception false
|
|
|
|
foreach child [hlist /$hpath] {
|
|
if [ catch {
|
|
array unset p_arr
|
|
array set p_arr [hlistprop /$hpath/$child tcllist]
|
|
if {([info exists p_arr(type)] == 0) || ($p_arr(type) != "nxvgroup")} {
|
|
set data_type [lindex [split [hinfo /$hpath/$child] , ] 0]
|
|
if {[info exists p_arr(data)] && ($p_arr(data) == true) && ($p_arr(nxsave) == true) } {
|
|
if {[info exists p_arr(nxalias)]} {
|
|
if {[info exists p_arr(savecmd)]} {
|
|
if {[info exists p_arr(mutable)] && ($p_arr(mutable) == "true") } {
|
|
$p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) /$hpath/$child $data_type $filestatus point $pt
|
|
} else {
|
|
$p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) /$hpath/$child $data_type $filestatus
|
|
}
|
|
} else {
|
|
if {[info exists p_arr(mutable)] && ($p_arr(mutable) == "true") } {
|
|
nxscript puthdb /$hpath/$child point $pt
|
|
} else {
|
|
nxscript puthdb /$hpath/$child
|
|
}
|
|
if {$filestatus == "newfile"} {
|
|
if {[info exists p_arr(link)] && ($p_arr(link) != "@none")} {
|
|
nxscript makelink $p_arr(link) $p_arr(nxalias)
|
|
}
|
|
}
|
|
}
|
|
}
|
|
::nexus::savetree $hpath/$child $pt $filestatus
|
|
}
|
|
}
|
|
} message ] {
|
|
lappend msglst $message
|
|
set caught_exception true
|
|
}
|
|
}
|
|
if {$caught_exception} {
|
|
return -code error "([info level 0]) $msglst"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Recursive portion of gen_nxdict function
|
|
#
|
|
# @param hpath hdb subtree path to generate dictionary fragment from, must not be "/"
|
|
# @param dictPath parent path for nexus dictionary fragment.
|
|
# @param name name for child dictionary path
|
|
# @param nxc Nexus class name
|
|
#
|
|
# If the klass name doesn't begin with NX then construct the SDS name by replacing '/' with '_' in the
|
|
# hdb path
|
|
#
|
|
# @see gen_nxdict
|
|
proc ::nexus::_gen_nxdict {hpath dictPath name nxc} {
|
|
variable nxdictionary
|
|
if [ catch {
|
|
if {[hpropexists /$hpath data] && [hgetpropval /$hpath data] == true} {
|
|
foreach child [hlist /$hpath] {
|
|
if {[hpropexists /$hpath/$child data] && [hgetpropval /$hpath/$child data] == true} {
|
|
set nxclass [hgetpropval /$hpath/$child klass]
|
|
if {$nxc == "NXentry"} {
|
|
::nexus::_gen_nxdict $hpath/$child $dictPath $child $nxclass
|
|
} else {
|
|
::nexus::_gen_nxdict $hpath/$child $dictPath/$name,$nxc $child $nxclass
|
|
}
|
|
}
|
|
}
|
|
array set p_arr [hlistprop /$hpath tcllist]
|
|
set data_type [lindex [split [hinfo /$hpath] , ] 0]
|
|
if {$data_type != "none" || $p_arr(type) == "nxvgroup"} {
|
|
#XXX Do we need to check data_type here. This would skip NXVGROUP nodes
|
|
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(sdsname)]} {
|
|
set sdsName $p_arr(sdsname)
|
|
} else {
|
|
set sdsName $name
|
|
}
|
|
if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true"} {
|
|
set isMutable "true"
|
|
} else {
|
|
set isMutable "false"
|
|
}
|
|
if {[info exists p_arr(savecmd)]} {
|
|
set SDSstr "[$p_arr(sdsinfo) $sdsName $data_type $p_arr(sicsdev) mutable $isMutable hpath /$hpath]"
|
|
} else {
|
|
set SDSstr "[$p_arr(sdsinfo) $sdsName $data_type mutable $isMutable hpath /$hpath]"
|
|
}
|
|
set nxdictionary($alias) "$dictPath/SDS $SDSstr"
|
|
} elseif {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
|
|
set nxdictionary($alias) "$dictPath/NXVGROUP"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Generate the NXentry name
|
|
#
|
|
# @param baseName, this is the data file basename it is used as the entry name
|
|
# when the 'fname' naming convention is selected.
|
|
proc ::nexus::gen_NXentry_name {baseName} {
|
|
variable NXentry_nm_convention
|
|
|
|
set nm_conv $NXentry_nm_convention([instname])
|
|
switch $nm_conv {
|
|
"simple" {
|
|
return "entry1"
|
|
}
|
|
"fname" {
|
|
return "${baseName}"
|
|
}
|
|
default {
|
|
return -code error "ERROR: Unknown NXentry naming convention $nm_conv"
|
|
}
|
|
}
|
|
}
|
|
##
|
|
# @brief Generate a nexus dictionary file from the hdb tree
|
|
#
|
|
# An entry in the nexus dictionary is generated for each node in the
|
|
# hdb tree which has the following properties and values, data=true and nxsave=true
|
|
#
|
|
# @param baseName The base name of the file without suffix
|
|
# @param nexusdic Name of the nexus dictionary that will be created.
|
|
# @return Full path to the nexus dictionary.
|
|
proc ::nexus::gen_nxdict {nexusdic} {
|
|
global cfPath
|
|
variable nxdictionary
|
|
if [ catch {
|
|
set nxdict_path $cfPath(nexus)/$nexusdic
|
|
array unset nxdictionary
|
|
foreach hp [hlist /] {
|
|
if {[hgetpropval /$hp data] == true} {
|
|
set nxclass [hgetpropval /$hp klass]
|
|
::nexus::_gen_nxdict $hp /\$(pa_entryName),NXentry $hp $nxclass
|
|
}
|
|
}
|
|
set fh [open $nxdict_path w]
|
|
puts $fh "##NXDICT-1.0"
|
|
puts $fh pa_entryName=entry1
|
|
puts $fh pa_hmmdimstr=-1,0
|
|
puts $fh pa_hmmrank=1
|
|
puts $fh pa_hmmdatname=hmm
|
|
puts $fh "data_save_error = /\$(pa_entryName),NXentry/SDS data_save_error -type NX_CHAR"
|
|
|
|
foreach {n v} [array get nxdictionary] {
|
|
puts $fh "$n = $v"
|
|
}
|
|
close $fh
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $nxdict_path
|
|
}
|
|
|
|
##
|
|
# @brief Set SICS object attributes which are required for creating nexus data files.
|
|
proc ::nexus::set_sobj_attributes {} {
|
|
if [ catch {
|
|
# SICS commands
|
|
sicslist setatt nxscript privilege internal
|
|
# SICS data objects
|
|
sicslist setatt nxscript_data privilege internal
|
|
|
|
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
|
|
}
|
|
foreach sobj [sicslist type environment_controller] {
|
|
sicslist setatt $sobj savecmd ::nexus::environment_controller::save
|
|
sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo
|
|
}
|
|
foreach sobj [sicslist type chopperadapter] {
|
|
sicslist setatt $sobj savecmd ::nexus::chopperadapter::save
|
|
sicslist setatt $sobj sdsinfo ::nexus::chopperadapter::sdsinfo
|
|
}
|
|
foreach sobj [sicslist kind script] {
|
|
sicslist setatt $sobj savecmd ::nexus::script::save
|
|
sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo
|
|
}
|
|
foreach sobj [sicslist kind getset] {
|
|
sicslist setatt $sobj savecmd ::nexus::macro::getset_save
|
|
sicslist setatt $sobj sdsinfo ::nexus::macro::getset_sdsinfo
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Convert the given hdb type to Nexus data type
|
|
#
|
|
# @param dtype hdb data type
|
|
# @return Nexus data type
|
|
proc ::nexus::hdb2nx_type {dtype} {
|
|
switch $dtype {
|
|
int {return NX_INT32}
|
|
intar {return NX_INT32}
|
|
intvarar {return NX_INT32}
|
|
float {return NX_FLOAT32}
|
|
floatar {return NX_FLOAT32}
|
|
floatvarar {return NX_FLOAT32}
|
|
text {return NX_CHAR}
|
|
default {error "ERROR: [info level -1]->hdb2nx_type, Unknown type $dtype"}
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Save command for histogram memory data.
|
|
#
|
|
# The savecmd attribute of any histogram memory objects should be set to this function
|
|
#
|
|
# @see set_sobj_attributes
|
|
proc ::nexus::histmem::save {hm nxalias hpath data_type filestatus args} {
|
|
variable HMOBJ
|
|
|
|
if [catch {
|
|
set point [lindex $args 1]
|
|
array set pa [hlistprop $hpath tcllist]
|
|
foreach sdsname $pa(hmmdatname) rank $pa(hmmrank) dimstr $pa(hmmdimstr) hmmslabstart $pa(hmmslabstart) hmmslabend $pa(hmmslabend) hmmperiodsize $pa(hmmperiodsize) axes $pa(@axes) signal $pa(@signal) {
|
|
nxscript updatedictvar pa_hmmdatname $sdsname
|
|
if {$pa(mutable)} {
|
|
nxscript updatedictvar pa_hmmrank [expr {$rank+1}]
|
|
nxscript updatedictvar pa_hmmdimstr "-1,$dimstr"
|
|
} else {
|
|
nxscript updatedictvar pa_hmmrank $rank
|
|
nxscript updatedictvar pa_hmmdimstr $dimstr
|
|
}
|
|
set max_period [SplitReply [$HMOBJ configure maximum_period]]
|
|
set datsize $hmmperiodsize
|
|
if {$pa(save_periods) == "all_periods"} {
|
|
$HMOBJ configure read_data_period_number -1
|
|
set datsize [expr $hmmperiodsize * (1 + $max_period)]
|
|
} elseif { $max_period > 0} {
|
|
$HMOBJ configure read_data_period_number $point
|
|
}
|
|
nxscript putslab $nxalias [join [list $point $hmmslabstart ]] [join [list 1 $hmmslabend]] $HMOBJ 0 $datsize 1
|
|
#####
|
|
if {$filestatus == "newfile"} {
|
|
if [hpropexists $hpath link] {
|
|
set link [hgetpropval $hpath link]
|
|
nxscript makelink $link $nxalias
|
|
}
|
|
nxscript putattribute $nxalias axes $axes
|
|
nxscript putattribute $nxalias signal $signal
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
proc ::nexus::histmem::sdsinfo {sdsName data_type hm args} {
|
|
return "\$(pa_hmmdatname) -type NX_INT32 -LZW -rank \$(pa_hmmrank) -dim {\$(pa_hmmdimstr)}"
|
|
}
|
|
|
|
# The save commands are called with the sobj name and nxalias
|
|
# The sdsinfo commands provide the SDS description for an nxdic
|
|
|
|
proc ::nexus::motor::save {motor nxalias hpath data_type filestatus args} {
|
|
if [ catch {
|
|
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]]
|
|
}
|
|
}
|
|
if {$filestatus == "newfile"} {
|
|
if [hpropexists $hpath link] {
|
|
set link [hgetpropval $hpath link]
|
|
nxscript makelink $link $nxalias
|
|
}
|
|
foreach {propName propValue} [hfindprop $hpath @*] {
|
|
set attName [string range $propName 1 end]
|
|
nxscript putattribute $nxalias $attName $propValue
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
proc ::nexus::motor::sdsinfo {sdsName data_type motor args} {
|
|
if [ catch {
|
|
array set param $args
|
|
array set attribute [::utility::normalattlist $motor]
|
|
if {[info exists attribute(units)]} {
|
|
set units_att " -attr {units,$attribute(units)} "
|
|
} else {
|
|
set units_att " "
|
|
}
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
set name_att " -attr {long_name,$attribute(long_name)} "
|
|
if {$param(mutable) == true} {
|
|
set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att $name_att"
|
|
} else {
|
|
set sdsStr "$sdsName -type $dtype $units_att $name_att"
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $sdsStr
|
|
}
|
|
##
|
|
# @brief Save data from a 'getset macro'
|
|
#
|
|
# NOTE: Currently just saves floats
|
|
namespace eval ::nexus::macro {}
|
|
proc ::nexus::macro::getset_save {sobj nxalias hpath data_type filestatus args} {
|
|
if [ catch {
|
|
if {[lindex $args 0] == "point"} {
|
|
set index [lindex $args 1]
|
|
nxscript_data clear
|
|
set val [getVal [$sobj] ]
|
|
switch $data_type {
|
|
int {nxscript_data putint 0 $val}
|
|
float {nxscript_data putfloat 0 $val}
|
|
text {error "ERROR: [info level 0] Saving an array of text values is not implemented"}
|
|
default {error "ERROR: [info level 0] unknown type $data_type when saving $sobj"}
|
|
}
|
|
nxscript putslab $nxalias [list $index] [list 1] nxscript_data
|
|
} else {
|
|
switch $data_type {
|
|
int {nxscript putint $nxalias [SplitReply [$sobj]]}
|
|
float {nxscript putfloat $nxalias [SplitReply [$sobj]]}
|
|
text {nxscript puttext $nxalias [SplitReply [$sobj]]}
|
|
default {error "ERROR: [info level 0] Unknown data type $data_type when saving $sobj"}
|
|
}
|
|
}
|
|
if {$filestatus == "newfile"} {
|
|
if [hpropexists $hpath link] {
|
|
set link [hgetpropval $hpath link]
|
|
nxscript makelink $link $nxalias
|
|
}
|
|
foreach {propName propValue} [hfindprop $hpath @*] {
|
|
set attName [string range $propName 1 end]
|
|
nxscript putattribute $nxalias $attName $propValue
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Define the scientific data set path for the nexus dictionary.
|
|
proc ::nexus::macro::getset_sdsinfo {sdsName data_type sobj args} {
|
|
if [ catch {
|
|
array set param $args
|
|
array set attribute [::utility::normalattlist $sobj]
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
if {[info exists attribute(units)]} {
|
|
set units_att " -attr {units,$attribute(units)} "
|
|
} else {
|
|
set units_att " "
|
|
}
|
|
set name_att " -attr {long_name,$attribute(long_name)} "
|
|
if {$param(mutable) == true} {
|
|
set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att $name_att"
|
|
} else {
|
|
set sdsStr "$sdsName -type $dtype $units_att $name_att"
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $sdsStr
|
|
}
|
|
####
|
|
proc ::nexus::environment_controller::save {evc nxalias hpath data_type filestatus args} {
|
|
if [ catch {
|
|
if {[lindex $args 0] == "point"} {
|
|
set index [lindex $args 1]
|
|
nxscript_data clear
|
|
nxscript_data putfloat 0 [getVal [$evc] ]
|
|
nxscript putslab $nxalias [list $index] [list 1] nxscript_data
|
|
} else {
|
|
nxscript putfloat $nxalias [SplitReply [$evc]]
|
|
}
|
|
if {$filestatus == "newfile"} {
|
|
if [hpropexists $hpath link] {
|
|
set link [hgetpropval $hpath link]
|
|
nxscript makelink $link $nxalias
|
|
}
|
|
foreach {propName propValue} [hfindprop $hpath @*] {
|
|
set attName [string range $propName 1 end]
|
|
nxscript putattribute $nxalias $attName $propValue
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
proc ::nexus::environment_controller::sdsinfo {sdsName data_type evc args} {
|
|
if [ catch {
|
|
array set param $args
|
|
array set attribute [::utility::normalattlist $evc]
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
if {[info exists attribute(units)]} {
|
|
set units_att " -attr {units,$attribute(units)} "
|
|
} else {
|
|
set units_att " "
|
|
}
|
|
set name_att " -attr {long_name,$attribute(long_name)} "
|
|
if {$param(mutable) == true} {
|
|
set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att $name_att"
|
|
} else {
|
|
set sdsStr "$sdsName -type $dtype $units_att $name_att"
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $sdsStr
|
|
}
|
|
|
|
namespace eval ::nexus {
|
|
}
|
|
|
|
proc ::nexus::sicsvariable::save {svar nxalias hpath data_type filestatus args} {
|
|
if [ catch {
|
|
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"}
|
|
}
|
|
}
|
|
if {$filestatus == "newfile"} {
|
|
if [hpropexists $hpath link] {
|
|
set link [hgetpropval $hpath link]
|
|
nxscript makelink $link $nxalias
|
|
}
|
|
foreach {propName propValue} [hfindprop $hpath @*] {
|
|
set attName [string range $propName 1 end]
|
|
nxscript putattribute $nxalias $attName $propValue
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "::nexus::sicsvariable::save, $message"
|
|
}
|
|
}
|
|
|
|
proc ::nexus::sicsvariable::sdsinfo {sdsName data_type sobj args} {
|
|
if [ catch {
|
|
array set param $args
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
array set attribute [::utility::normalattlist $sobj]
|
|
if {[info exists attribute(units)]} {
|
|
set units_att " -attr {units,$attribute(units)} "
|
|
} else {
|
|
set units_att " "
|
|
}
|
|
if {$param(mutable) == true} {
|
|
set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att"
|
|
} else {
|
|
set sdsStr "$sdsName -type $dtype $units_att"
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $sdsStr
|
|
}
|
|
|
|
namespace eval ::nexus::scobj {}
|
|
proc ::nexus::scobj::sdsinfo {sdsName data_type args} {
|
|
if [ catch {
|
|
array set param $args
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
if [hpropexists $param(hpath) "units"] {
|
|
set unitsval [hgetpropval $param(hpath) units]
|
|
set units_att " -attr {units,$unitsval} "
|
|
} else {
|
|
set units_att " "
|
|
}
|
|
switch $data_type {
|
|
text {
|
|
set dimdef [subst {-dim {[string length [hval $param(hpath)]]}}]
|
|
set sdsStr "$sdsName -type $dtype $dimdef"
|
|
}
|
|
default {
|
|
if {$param(mutable) == true} {
|
|
set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att"
|
|
} else {
|
|
set sdsStr "$sdsName -type $dtype $units_att"
|
|
}
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $sdsStr
|
|
}
|
|
|
|
namespace eval ::nexus::chopperadapter { }
|
|
proc ::nexus::chopperadapter::save {sobj nxalias hpath data_type filestatus args} {
|
|
if [ catch {
|
|
array set attribute [attlist $sobj]
|
|
set val [SplitReply [$sobj]]
|
|
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::chopperadapter::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::chopperadapter::save, unknown type $data_type"}
|
|
}
|
|
}
|
|
if {$filestatus == "newfile"} {
|
|
if [hpropexists $hpath link] {
|
|
set link [hgetpropval $hpath link]
|
|
nxscript makelink $link $nxalias
|
|
}
|
|
foreach {propName propValue} [hfindprop $hpath @*] {
|
|
set attName [string range $propName 1 end]
|
|
nxscript putattribute $nxalias $attName $propValue
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
proc ::nexus::chopperadapter::sdsinfo {sdsName data_type sobj args} {
|
|
if [ catch {
|
|
array set param $args
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
array set attribute [::utility::normalattlist $sobj]
|
|
if {[info exists attribute(units)]} {
|
|
set units_att " -attr {units,$attribute(units)} "
|
|
} else {
|
|
set units_att " "
|
|
}
|
|
if {$param(mutable) == true} {
|
|
set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att"
|
|
} else {
|
|
set sdsStr "$sdsName -type $dtype $units_att"
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $sdsStr
|
|
}
|
|
proc ::nexus::singlecounter::save {counter nxalias hpath data_type filestatus args} {
|
|
todo_msg "Save counter: $counter"
|
|
}
|
|
proc ::nexus::singlecounter::sdsinfo {sdsName data_type counter args} {
|
|
todo_msg "Get sdsinfo for counter: $counter"
|
|
}
|
|
|
|
##
|
|
# @brief Save command for hdb nodes associated with a tcl macro
|
|
#
|
|
# The macro must return the name of a 1D associative array when called with -get_data_ref.
|
|
proc ::nexus::script::save {script nxalias hpath data_type filestatus args} {
|
|
if [ catch {
|
|
array set attribute [attlist $script]
|
|
if {$attribute(klass) == "sensor"} {
|
|
if {[lindex $args 0] == "point"} {
|
|
set index [lindex $args 1]
|
|
nxscript_data clear
|
|
nxscript_data putfloat 0 [$script]
|
|
nxscript putslab $nxalias [list $index] [list 1] nxscript_data
|
|
} else {
|
|
nxscript putfloat $nxalias [$script]
|
|
}
|
|
} else {
|
|
set darray [$script -get_data_ref]
|
|
set size [SplitReply [$darray used]]
|
|
if {[lindex $args 0] == "point"} {
|
|
set index [lindex $args 1]
|
|
nxscript putslab $nxalias [list $index 0] [list 1 $size] $darray
|
|
} else {
|
|
nxscript putslab $nxalias [list 0] [list $size] $darray
|
|
}
|
|
}
|
|
if {$filestatus == "newfile"} {
|
|
if [hpropexists $hpath link] {
|
|
set link [hgetpropval $hpath link]
|
|
nxscript makelink $link $nxalias
|
|
}
|
|
foreach {propName propValue} [hfindprop $hpath @*] {
|
|
set attName [string range $propName 1 end]
|
|
nxscript putattribute $nxalias $attName $propValue
|
|
}
|
|
}
|
|
} message ] {
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
}
|
|
|
|
proc ::nexus::script::sdsinfo {sdsName data_type sobj args} {
|
|
if [ catch {
|
|
array set param $args
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
array set attribute [::utility::normalattlist $sobj]
|
|
if {[info exists attribute(units)]} {
|
|
set units_att " -attr {units,$attribute(units)} "
|
|
} else {
|
|
set units_att " "
|
|
}
|
|
if {[getatt $sobj klass] == "sensor"} {
|
|
if {$param(mutable) == true} {
|
|
set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att"
|
|
} else {
|
|
set sdsStr "$sdsName -type $dtype $units_att"
|
|
}
|
|
} else {
|
|
set darray [$sobj -get_data_ref]
|
|
set size [SplitReply [$darray used]]
|
|
if {$param(mutable) == true} {
|
|
set sdsStr "$sdsName -type $dtype $units_att -rank 2 -dim {-1,$size}"
|
|
} else {
|
|
set sdsStr "$sdsName -type $dtype $units_att -rank 1 -dim {$size}"
|
|
}
|
|
}
|
|
} message ] {
|
|
#TODO CHECK ERROR: failed to open alias ::histogram_memory::y_bin etc.
|
|
return -code error "([info level 0]) $message"
|
|
}
|
|
return $sdsStr
|
|
}
|
|
namespace import ::nexus::*
|
|
foreach expt $::nexus::exports {
|
|
publish $expt user
|
|
sicslist setatt $expt privilege internal
|
|
}
|
|
|
|
# TODO Return filename from nxcreatefile and call nxreopen nxclose etc
|
|
|
|
# dictalias is a global hash which records the alias which the value of
|
|
# a sics object (eg motors) is written to. The has is indexed by the
|
|
# objects name. It is useful for making links to datasets.
|
|
# dim0 = vertical axis on detector
|
|
# dim1 = horizontal axis on detector
|
|
|
|
set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}]
|
|
set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]]
|
|
::utility::mkVar sics_release Text manager sics_release true entry true true
|
|
sics_release $nx_content_release_tag
|
|
sics_release lock
|
|
|
|
set tmpstr [string map {"$" ""} {$Revision: 1.51.2.4 $}]
|
|
set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
|
|
|
|
#namespace eval data {
|
|
# ##
|
|
# # @brief Nexus data save command for gumtree control interface
|
|
# #
|
|
# # @param run_number This is the run or scan point number, it serves as the array
|
|
# # index for nexus data sets which correspond to mutable data
|
|
# command gumtree_save {int: run_number} {
|
|
# ::nexus::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} {
|
|
# SicsDataPostFix $type
|
|
# }
|
|
# sicslist set ::data::gumtree_type long_name file_format
|
|
# ::data::gumtree_type -set type [SplitReply [SicsDataPostFix]]
|
|
#}
|
|
|
|
::nexus::init
|
|
publish ::nexus::data user
|