870 lines
30 KiB
Tcl
870 lines
30 KiB
Tcl
## TODO Put all the nexus macros in the nexus namespace
|
|
MakeNXScript
|
|
sicsdatafactory new nxscript_data
|
|
namespace eval nexus {
|
|
variable nxdictionary
|
|
variable state
|
|
|
|
set exports [list newfile closefile save data]
|
|
eval namespace export $exports
|
|
datafilename
|
|
|
|
proc init {} {
|
|
variable state
|
|
variable nexusdic
|
|
array set state {file,new "true" file,open "false" file,type "data" file,format "hdf"}
|
|
set nexusdic "nexus.dic"
|
|
}
|
|
|
|
## \brief Create a nexus file
|
|
#
|
|
# \param filetype optional, (data,scratch) default=data
|
|
#
|
|
# Depends on ::nexus variable nexusdic and sics variable SicsDataPostFix
|
|
# preconditions:
|
|
# state(file,open) false state(file,new) true
|
|
# postconditions:
|
|
# state(file,open) true state(file,new) false
|
|
# /data/currentfiletype == /data/datatype
|
|
proc createfile {} {
|
|
global cfPath
|
|
variable nexusdic
|
|
variable state
|
|
variable nxFileOpen;
|
|
if {$state(file,open) == "true"} {
|
|
error_msg "Can't create a new file because the current file is still open"
|
|
} elseif {$state(file,new) == "false"} {
|
|
error_msg "This function should only be called when state(file,new) = true"
|
|
}
|
|
set nxdict_path $cfPath(nexus)/$nexusdic
|
|
set file_format [SplitReply [SicsDataPostFix]]
|
|
array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml];
|
|
::nexus::gen_nxdict $nexusdic
|
|
if {$state(file,type) == "scratch"} {
|
|
dataFileName [format "scratch.%s" $file_format]
|
|
} else {
|
|
sicsdatanumber incr;
|
|
dataFileName [newFileName $file_format]
|
|
}
|
|
hsetprop /data currentfiletype [::utility::hgetplainprop /data datatype]
|
|
nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path;
|
|
set nxFileOpen true
|
|
set state(file,open) false
|
|
set state(file,new) false
|
|
}
|
|
|
|
## \brief Setup file state info for writing a new file.
|
|
#
|
|
# \param type
|
|
#
|
|
# postconditions:
|
|
# state(file,open) true state(file,new) false
|
|
# /data/currentfiletype == UNKNOWN
|
|
proc newfile {{type data}} {
|
|
variable state
|
|
|
|
set state(file,type) $type
|
|
set state(file,new) true
|
|
hsetprop /data currentfiletype UNKNOWN
|
|
}
|
|
|
|
proc save_data {point} {
|
|
debug_msg "save point $point in [dataFileName]"
|
|
::nexus::nxreopenfile
|
|
foreach child [hlist /] {
|
|
if {[::utility::hgetplainprop /$child 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
|
|
# \param filetype optional, (data,scratch) default=data
|
|
#
|
|
# If filetype == scratch then it will create a file called scratch.{xml|hdf}
|
|
# 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.
|
|
# arg0 '' n scratch data xml hdf
|
|
# arg1 '' scratch data xml hdf
|
|
# arg2 '' xml hdf
|
|
proc save {args} {
|
|
variable state
|
|
if {$args == ""} {
|
|
set point 0
|
|
} else {
|
|
set point [lindex $args 0]
|
|
}
|
|
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
|
|
|
|
set isNewFile [expr {$state(file,new) == "true"}]
|
|
set currFileType [::utility::hgetplainprop /data currentfiletype]
|
|
set currDataType [::utility::hgetplainprop /data datatype]
|
|
set dataTypeChanged [expr {$currFileType != $currDataType}]
|
|
|
|
if {$isNewFile || $dataTypeChanged} {
|
|
set state(file,new) true
|
|
::nexus::createfile
|
|
::nexus::save_data $point
|
|
::nexus::linkdata
|
|
} else {
|
|
::nexus::save_data $point
|
|
}
|
|
|
|
return
|
|
}
|
|
|
|
## \brief Reopen the current file, close it with nxclosefile
|
|
#
|
|
# preconditions:
|
|
# none
|
|
# postconditions:
|
|
# state(file,open) == true
|
|
# \see nxclosefile
|
|
proc nxreopenfile {} {
|
|
global cfPath
|
|
variable state
|
|
variable nxFileOpen
|
|
variable nexusdic
|
|
if {$state(file,open) == "false"} {
|
|
nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
|
|
set state(file,open) true
|
|
}
|
|
}
|
|
|
|
## \brief Close the current file. You can reopen it with nxreopenfile
|
|
#
|
|
# preconditions
|
|
# none
|
|
# postconditions
|
|
# state(file,open) == false
|
|
# \see nxreopenfile
|
|
proc nxclosefile {} {
|
|
variable state
|
|
variable nxFileOpen;
|
|
if {$state(file,open) == "true"} {
|
|
nxscript close;
|
|
set state(file,open) 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
|
|
# data alias <name>, remove alias <name>
|
|
# data alias <name> <target>, set <name> as an alias for <target> unless it has already been defined.
|
|
proc data {args} {
|
|
variable state
|
|
|
|
set dpath /data
|
|
set opt [lindex $args 0]
|
|
set arglist [lrange $args 1 end]
|
|
|
|
switch $opt {
|
|
"axis" {
|
|
debug_msg "'axis' case of switch"
|
|
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 [getatt [lindex $args 2] id]
|
|
hsetprop $hp long_name [getatt [lindex $args 2] long_name]
|
|
}
|
|
}
|
|
"data_set" {
|
|
debug_msg "'data_set' case of switch"
|
|
hsetprop $dpath datatype [lindex [info level -1] 0]
|
|
set hp $dpath/data_set
|
|
if {[::utility::hgetplainprop $hp link] == "@none"} {
|
|
hsetprop $hp link [getatt [lindex $args 1] id]
|
|
hsetprop $hp long_name [getatt [lindex $args 1] 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
|
|
}
|
|
return
|
|
}
|
|
}
|
|
}
|
|
default {error "ERROR: [info level -1]->data, Unsupported option $opt"}
|
|
}
|
|
}
|
|
# Internal commands
|
|
# All experimental data of interest is linked under the data group
|
|
## \brief Links data and axis into /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]] {
|
|
lappend axes_list $axes($n)
|
|
}
|
|
nxscript putattribute $data_set_alias axes [join $axes_list :]
|
|
}
|
|
::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 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
|
|
}
|
|
foreach sobj [sicslist kind script] {
|
|
sicslist setatt $sobj savecmd ::nexus::script::save
|
|
sicslist setatt $sobj sdsinfo ::nexus::script::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::evcontroller {
|
|
# 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 {evc nxalias data_type args} {
|
|
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]]
|
|
}
|
|
}
|
|
proc sdsinfo {evc data_type args} {
|
|
array set param $args
|
|
array set evc_prop [attlist $evc]
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
if {$param(mutable) == true} {
|
|
return " -type $dtype -rank 1 -dim {-1} -attr {units,$evc_prop(units)} -attr {long_name,$evc_prop(long_name)}"
|
|
} else {
|
|
return " -type $dtype -attr {units,$evc_prop(units)} -attr {long_name,$evc_prop(long_name)}"
|
|
}
|
|
}
|
|
}
|
|
namespace eval ::nexus {
|
|
proc 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"}
|
|
}
|
|
}
|
|
}
|
|
|
|
namespace eval ::nexus::sicsvariable {
|
|
proc save {svar nxalias data_type args} {
|
|
array set attribute [attlist $svar]
|
|
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 {[info exists attribute(units)]} {
|
|
nxscript putattribute $nxalias units $attribute(units)
|
|
}
|
|
}
|
|
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"
|
|
}
|
|
}
|
|
|
|
namespace eval ::nexus::script {
|
|
##\brief Save command for hdb nodes associated with a tcl macro
|
|
#
|
|
# The macro must return a 1D associative array when called with -arrayname.
|
|
proc save {script nxalias data_type args} {
|
|
array set attribute [attlist $script]
|
|
set darray [$script -arrayname]
|
|
set size [array size $darray]
|
|
switch $data_type {
|
|
"intar" - "intvarar" {
|
|
nxscript putintarray $nxalias $darray $size
|
|
}
|
|
"floatar" - "floatvarar" {
|
|
nxscript putarray $nxalias $darray $size
|
|
}
|
|
}
|
|
if {[info exists attribute(units)]} {
|
|
nxscript putattribute $nxalias units $attribute(units)
|
|
}
|
|
}
|
|
proc sdsinfo {script data_type args} {
|
|
set dtype [::nexus::hdb2nx_type $data_type]
|
|
set darray [$script -arrayname]
|
|
set size [array size $darray]
|
|
return " -type $dtype -rank 1 -dim {$size}"
|
|
}
|
|
}
|
|
# TODO Return filename from nxcreatefile and call nxreopen nxclose etc
|
|
# TODO Make an nxscript namespace for all this.
|
|
|
|
# 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]]
|
|
set tmpstr [string map {"$" ""} {$Revision: 1.28 $}]
|
|
set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
|
|
|
|
|
|
proc getVal {msg} {
|
|
return [string trim [lindex [split $msg =] 1 ] ]
|
|
}
|
|
|
|
proc newFileName {postfix} {
|
|
array set inst_mnem {quokka QKK wombat 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 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%07d.%s" $dataPath $inst_mnem([instname]) $idNum $postfix]
|
|
}
|
|
|
|
|
|
|
|
set dradius 1.25
|
|
set ndect 128
|
|
set tubedia 0.0254
|
|
set pi 3.1415926
|
|
set angsep 1.25
|
|
# stthmin = (180 - (1.25*127))/2
|
|
|
|
proc hmm_save {nxobj entryname point} {
|
|
global dradius ndect angsep dictalias;
|
|
set dictalias(hmm) hmcounts
|
|
# dim0 is vertical and dim1 is horizontal
|
|
set dim0 [SplitReply [hmm configure dim0]];
|
|
set dim1 [SplitReply [hmm configure dim1]];
|
|
putcommon $nxobj $entryname $point;
|
|
putcrystal $nxobj;
|
|
putmonitor $nxobj $point;
|
|
putsample $nxobj;
|
|
|
|
$nxobj putattribute program_name hmm_mode [SplitReply [hmm_mode]]
|
|
$nxobj putfloat detangle_degrees [SplitReply [detector_angle_deg]]
|
|
$nxobj putfloat dheight [SplitReply [detector_active_height_mm]]
|
|
put_det_haxis_arr $nxobj $dim1;
|
|
put_det_vaxis_arr $nxobj $dim0;
|
|
$nxobj puttext dtype [SplitReply [detector_type]]
|
|
$nxobj puttext ddesc [SplitReply [detector_description]]
|
|
$nxobj putfloat dradius [SplitReply [detector_radius_mm]]
|
|
$nxobj puttext dlayout [SplitReply [detector_layout]]
|
|
set histo_length [SplitReply [hmm_length]]
|
|
$nxobj updatedictvar padim0 $dim0
|
|
$nxobj updatedictvar padim1 $dim1
|
|
$nxobj putslab $dictalias(hmm) [list $point 0 0] [list 1 $dim0 $dim1 ] hmm [SplitReply [hmm_start]] $histo_length [SplitReply [hmm_bank]]
|
|
put_polar_angle $nxobj $point $dim0 $dim1;
|
|
#TODO replace scandata with generic name
|
|
$nxobj makelink scandata hmcounts
|
|
$nxobj makelink scanhoraxis [SplitReply [_hmm_hor_axis_alias]]
|
|
$nxobj makelink scanvertaxis [SplitReply [_hmm_vert_axis_alias]]
|
|
$nxobj putattribute [SplitReply [_hmm_vert_axis_alias]] axis 2;
|
|
$nxobj putattribute [SplitReply [_hmm_hor_axis_alias]] axis 3;
|
|
}
|
|
|
|
proc hmm_addnxscanentry {nxobj entryname point scanVariable scanVarPos scanVarStep start_time} {
|
|
global dictalias;
|
|
set hor_axis [SplitReply [_hmm_hor_axis]]
|
|
set vert_axis [SplitReply [_hmm_vert_axis]]
|
|
|
|
$nxobj puttext estart $start_time;
|
|
$nxobj putattribute program_name run_mode hmscan
|
|
nxscript_data clear;
|
|
nxscript_data putint 0 $point;
|
|
$nxobj putslab erun [list $point] [list 1] nxscript_data;
|
|
hmm_save $nxobj $entryname $point;
|
|
fillPath $nxobj $scanVariable;
|
|
$nxobj makelink scanvar $dictalias($scanVariable);
|
|
$nxobj putattribute $dictalias($scanVariable) axis 1;
|
|
$nxobj putattribute hmcounts signal 1;
|
|
$nxobj putattribute hmcounts axes $scanVariable:$vert_axis:$hor_axis;
|
|
$nxobj puttext eend [sicstime];
|
|
}
|
|
|
|
proc bm_save {nxobj entryname point} {
|
|
global dradius ndect angsep;
|
|
# $nxobj updatedictvar scan_variable $scanVariable;
|
|
putcommon $nxobj $entryname $point
|
|
putcrystal $nxobj
|
|
putmonitor $nxobj $point
|
|
putsample $nxobj
|
|
$nxobj puttext dlayout point
|
|
#TODO replace scandata with generic name
|
|
$nxobj makelink scandata bmcounts
|
|
}
|
|
|
|
proc bm_addnxscanentry {nxobj entryname point scanVariable scanVarPos scanVarStep start_time} {
|
|
global dictalias;
|
|
|
|
$nxobj puttext estart $start_time;
|
|
$nxobj putattribute program_name run_mode bmonscan
|
|
nxscript_data clear;
|
|
nxscript_data putint 0 $point;
|
|
$nxobj putslab erun [list $point] [list 1] nxscript_data;
|
|
bm_save $nxobj $entryname $point;
|
|
fillPath $nxobj $scanVariable;
|
|
$nxobj makelink scanvar $dictalias($scanVariable);
|
|
$nxobj putattribute $dictalias($scanVariable) axis 1;
|
|
$nxobj putattribute bmcounts signal 1;
|
|
$nxobj putattribute bmcounts axes $scanVariable;
|
|
#TODO add dtype ddesc
|
|
$nxobj puttext eend [sicstime];
|
|
}
|
|
|
|
proc putmonitor {nxobj point} {
|
|
$nxobj puttext mmode [string trim [lindex [split [bm getmode] =] 1]]
|
|
$nxobj putfloat mpreset [string trim [lindex [split [bm getpreset] =] 1]]
|
|
# $nxobj putint mdata [string trim [lindex [split [bm getcounts] =] 1]]
|
|
nxscript_data clear
|
|
nxscript_data putfloat 0 [SplitReply [bm getcounts]]
|
|
$nxobj putslab bmcounts [list $point] [list 1] nxscript_data
|
|
$nxobj putfloat mdistance [SplitReply [bmon_distance]]
|
|
}
|
|
|
|
proc put_det_haxis_arr {nxobj dim1} {
|
|
set det_radius_mm [SplitReply [detector_radius_mm]]
|
|
set det_angle_rad [SplitReply [detector_angle_rad]]
|
|
set angsep [expr $det_angle_rad / ($dim1-1)]
|
|
|
|
for {set i 0} {$i < $dim1} {incr i} {
|
|
set col_index($i) [expr int($i)]
|
|
set xpixel_offset($i) [expr $i*$angsep*$det_radius_mm]
|
|
}
|
|
$nxobj putarray dhaxis xpixel_offset $dim1;
|
|
$nxobj updatedictvar column_index_name [SplitReply [_hmm_hor_channel_name]]
|
|
$nxobj putintarray dcolindex col_index $dim1;
|
|
}
|
|
|
|
proc put_det_vaxis_arr {nxobj dim0} {
|
|
set det_active_height_mm [SplitReply [detector_active_height_mm]]
|
|
set hsep [expr $det_active_height_mm/($dim0-1)]
|
|
set det_zero_row [SplitReply [detector_zero_row] ]
|
|
set det_last_vert_pixel [SplitReply [detector_last_vert_pixel]]
|
|
set row_zero [expr ($dim0 - 1.0)*$det_zero_row/$det_last_vert_pixel]
|
|
|
|
for {set i 0} {$i < $dim0} {incr i} {
|
|
set row_index($i) [expr int($i)]
|
|
set ypixel [expr $det_active_height_mm - ($i+$row_zero)*$hsep]
|
|
set det_ypixel_offset($i) $ypixel
|
|
}
|
|
|
|
$nxobj putarray dvaxis det_ypixel_offset $dim0
|
|
$nxobj updatedictvar row_index_name vertical_channel_number
|
|
$nxobj putintarray drowindex row_index $dim0;
|
|
}
|
|
|
|
proc putsample {nxobj} {
|
|
$nxobj puttext saname [getVal [Sample]]
|
|
}
|
|
proc putcrystal {nxobj} {
|
|
$nxobj puttext ctype [SplitReply [crystal_type]]
|
|
$nxobj putfloat clambda [SplitReply [crystal_wavelength_A]]
|
|
}
|
|
proc putcommon {nxobj entryName point} {
|
|
global nx_content_release_tag nx_content_revision_num;
|
|
$nxobj updatedictvar entryName $entryName
|
|
$nxobj puttext program_name SICS
|
|
$nxobj putattribute program_name sics_release [SplitReply [sics_release]]
|
|
$nxobj putattribute program_name sics_revision [SplitReply [sics_revision_num]]
|
|
$nxobj putattribute program_name nx_content_release $nx_content_release_tag
|
|
$nxobj putattribute program_name nx_content_revision $nx_content_revision_num
|
|
$nxobj puttext etitle [getVal [Title]]
|
|
$nxobj puttext iname [getVal [Instrument]]
|
|
$nxobj puttext username [SplitReply [user]]
|
|
$nxobj puttext useremail [SplitReply [email]]
|
|
$nxobj puttext userphone [SplitReply [phone]]
|
|
|
|
# NXsource
|
|
$nxobj puttext sname OPAL
|
|
$nxobj puttext stype Reactor Neutron Source
|
|
$nxobj puttext sprobe Neutron
|
|
putsamplemotors $nxobj $point
|
|
putslitmotors $nxobj $point
|
|
putmonomotors $nxobj $point
|
|
}
|
|
|
|
# This should be called before making a link to a dataset
|
|
# via a value in the dictalias hash.
|
|
proc fillPath {nxobj sobj} {
|
|
set otype [SplitReply [sicslist $sobj type]];
|
|
if {$otype == "Motor"} {
|
|
fillMotPath $nxobj $sobj;
|
|
}
|
|
}
|
|
|
|
proc fillMotPath {nxobj motor} {
|
|
$nxobj updatedictvar mot_name $motor;
|
|
$nxobj updatedictvar mot_long_name [SplitReply [$motor long_name]];
|
|
$nxobj updatedictvar mot_units [SplitReply [$motor units]];
|
|
}
|
|
|
|
proc putsamplemotors {nxobj point} {
|
|
global dictalias;
|
|
|
|
foreach motor { som schi sphi sx sy stth } {
|
|
fillMotPath $nxobj $motor;
|
|
set dictalias($motor) nxsample_mot
|
|
nxscript_data clear;
|
|
nxscript_data putfloat 0 [getVal [$motor] ];
|
|
$nxobj putslab $dictalias($motor) [list $point] [list 1] nxscript_data;
|
|
}
|
|
# sth is a virtual motor
|
|
nxscript_data clear
|
|
nxscript_data putfloat 0 [getVal [sth ]]
|
|
set dictalias(sth) sth
|
|
$nxobj putslab $dictalias(sth) [list $point] [list 1] nxscript_data;
|
|
}
|
|
|
|
proc putmonomotors {nxobj point} {
|
|
global dictalias;
|
|
|
|
set instrument [SplitReply [instrument]]
|
|
|
|
if {$instrument == "echidna"} {
|
|
set extra_mots [list pcx pcr]
|
|
} elseif {$instrument == "wombat"} {
|
|
set extra_mots [list oct mf2]
|
|
}
|
|
foreach motor " mom mchi mphi mx my mtth $extra_mots" {
|
|
fillMotPath $nxobj $motor;
|
|
set dictalias($motor) nxcrystal_mot
|
|
nxscript_data clear
|
|
nxscript_data putfloat 0 [getVal [$motor] ]
|
|
$nxobj putslab $dictalias($motor) [list $point] [list 1] nxscript_data;
|
|
}
|
|
# mth is a virtual motor
|
|
nxscript_data clear
|
|
nxscript_data putfloat 0 [getVal [mth ]]
|
|
set dictalias(mth) mth
|
|
$nxobj putslab $dictalias(mth) [list $point] [list 1] nxscript_data;
|
|
}
|
|
|
|
proc putslitmotors {nxobj point} {
|
|
global dictalias;
|
|
|
|
foreach motor {ss1u ss1d ss1l ss1r ss2u ss2d ss2l ss2r } {
|
|
fillMotPath $nxobj $motor;
|
|
set dictalias($motor) nxfilter_mot
|
|
nxscript_data clear
|
|
nxscript_data putfloat 0 [getVal [$motor] ]
|
|
$nxobj putslab $dictalias($motor) [list $point] [list 1] nxscript_data;
|
|
}
|
|
foreach motor {ss1vg ss1vo ss1hg ss1ho ss2vg ss2vo ss2hg ss2ho } {
|
|
set dictalias($motor) $motor
|
|
nxscript_data clear
|
|
nxscript_data putfloat 0 [getVal [$motor] ]
|
|
$nxobj putslab $dictalias($motor) [list $point] [list 1] nxscript_data;
|
|
}
|
|
}
|
|
|
|
namespace eval 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]]
|
|
}
|
|
|
|
Publish addnxscanentry user
|
|
Publish bm_addnxscanentry user
|
|
::nexus::init
|