Merging release 2.0 branch with CVS trunk
r2601 | ffr | 2008-05-30 10:26:57 +1000 (Fri, 30 May 2008) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
4a937e1608
commit
0749b0effa
@@ -0,0 +1,167 @@
|
||||
# $Revision: 1.2 $
|
||||
# $Date: 2008-05-30 00:26:54 $
|
||||
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||
# Last revision by: $Author: ffr $
|
||||
|
||||
# TODO Handle sequencing when simultaneously moving multiple axes
|
||||
# TODO Handle functional dependencies (just write your own tcl script)
|
||||
# or get the generic acscript to call a user proc
|
||||
# FIXME The anticollider module does not report the error messages from the
|
||||
# anticollision script, we currently get around this by using broadcast.
|
||||
|
||||
AntiCollisionInstall
|
||||
namespace eval anticollider {
|
||||
variable veto_region
|
||||
}
|
||||
array unset ::anticollider::veto_region
|
||||
array set ::anticollider::veto_region ""
|
||||
|
||||
##
|
||||
# @brief Load an anticollider script
|
||||
proc ::anticollider::loadscript {args} {
|
||||
variable prog
|
||||
set prog ""
|
||||
|
||||
set fh [open $::cfPath(anticollider)/[lindex $args 0] RDONLY ]
|
||||
while {[gets $fh line] >= 0} {
|
||||
# Skip empty lines and comments
|
||||
if [regexp {^\s*$|^ *#} $line] {
|
||||
continue
|
||||
}
|
||||
lappend prog $line
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Compile compile an anticollider declaration into a veto region table
|
||||
# for the anticollider script.
|
||||
#
|
||||
# @param vprog, an anticollider declaration as a list of quote enclosed lines.
|
||||
# @return Generates the ::anticollider::veto_region lookup table.
|
||||
#
|
||||
# Example\n
|
||||
# forbid {160 167} for stth when mtth in {87 88}\n
|
||||
# forbid { {0 15} {20 25} } for stth when mtth in { {80 90} {139.5 140.5} }\n
|
||||
# for pcx forbid { {80 130} {-inf 10} }\n
|
||||
# when mom in {0 45} forbid {{0 15} {345 360}} for pcr\n
|
||||
# for sphi forbid { {0 5} {10 15} } when schi in { {5 10} {15 20} }\n
|
||||
# forbid {-inf 5} when mtth in {0 10} for sphi\n
|
||||
# forbid {0 10} for samx whenall { samrot in {0 5} samy in {0 15} }\n
|
||||
proc ::anticollider::genveto {vprog} {
|
||||
variable veto_region
|
||||
array unset veto_region
|
||||
set lnum 1
|
||||
|
||||
foreach line $vprog {
|
||||
array unset vp
|
||||
array set vp $line
|
||||
if [info exists vp(whenall)] {
|
||||
foreach {mot in range} $vp(whenall) {
|
||||
if {[llength [join $range]] != 2} {
|
||||
error "ERROR: $range is not a valid range for $mot. Line $lnum of the veto list"
|
||||
}
|
||||
lappend condlist $mot $range
|
||||
}
|
||||
lappend veto_region($vp(for)) [list $vp(forbid) @and $condlist]
|
||||
} elseif [info exists vp(when)] {
|
||||
lappend veto_region($vp(for)) [list $vp(forbid) $vp(when) $vp(in)]
|
||||
} else {
|
||||
lappend veto_region($vp(for)) [list $vp(forbid) @any @all]
|
||||
}
|
||||
incr lnum
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Generic anti-collision script for simple collision avoidance.
|
||||
#
|
||||
# WARNING: This does not handle sequencing. Only run one motor at a time.
|
||||
# This script requires that an ::anticollider::veto_region has been generated
|
||||
# by the ::anticollider::genveto procedure.
|
||||
#
|
||||
# The ::anticollider::veto_region is a hash indexed by the names of the motors
|
||||
# which have been registered with the anticollision module.
|
||||
proc ::anticollider::acscript {args} {
|
||||
variable veto_region
|
||||
|
||||
foreach {regmot target} $args {
|
||||
foreach row $veto_region($regmot) {
|
||||
if { [lindex $row 1] == "@and"} {
|
||||
set forbid [lindex $row 0]
|
||||
set no_veto 0
|
||||
foreach {mot range} [lindex $row 2] {
|
||||
set pos [SplitReply [$mot]]
|
||||
foreach {lower upper} $range {}
|
||||
if {$pos < $lower || $pos > $upper} {
|
||||
set no_veto 1
|
||||
break
|
||||
}
|
||||
}
|
||||
if {$no_veto} {
|
||||
continue
|
||||
} else {
|
||||
foreach {min max} $forbid {}
|
||||
if {$min <= $target && $target <= $max} {
|
||||
broadcast "ERROR:The range ($forbid) is forbidden for $regmot when [lindex $row 2]"
|
||||
error "ERROR:The range ($forbid) is forbidden for $regmot when [lindex $row 2]"
|
||||
}
|
||||
}
|
||||
} else {
|
||||
foreach {forbidden_range obstmot obstrange} $row {
|
||||
if {$obstmot == "@any"} {
|
||||
if {$obstrange == "@all"} {
|
||||
foreach {min max} [join $forbidden_range] {
|
||||
if {$min <= $target && $target <= $max} {
|
||||
broadcast "ERROR: $regmot target ($target) is in the forbidden region ($forbidden_range)"
|
||||
error "ERROR: $regmot target ($target) is in the forbidden region ($forbidden_range)"
|
||||
}
|
||||
}
|
||||
} else {
|
||||
broadcast "ERROR: veto table must use @all with @any"
|
||||
error "ERROR: veto table must use @all with @any"
|
||||
}
|
||||
} else {
|
||||
if {$obstrange == "@all"} {
|
||||
broadcast "ERROR: veto table must use @any with @all"
|
||||
error "ERROR: veto table must use @any with @all"
|
||||
} else {
|
||||
foreach {lower upper} [join $obstrange] {
|
||||
set pos [SplitReply [$obstmot]]
|
||||
if {$lower <= $pos && $pos <= $upper} {
|
||||
foreach {min max} [join $forbidden_range] {
|
||||
if {$min <= $target && $target <= $max} {
|
||||
broadcast "ERROR:The range $min to $max is forbidden for $regmot when $obstmot is in this region ($obstrange)"
|
||||
error "ERROR:The range $min to $max is forbidden for $regmot when $obstmot is in this region ($obstrange)"
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
anticollision add 0 $regmot $target
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Generate anticollider veto_region and register motors with anticollider
|
||||
proc ::anticollider::init {} {
|
||||
variable evp
|
||||
variable veto_region
|
||||
|
||||
if [ catch {
|
||||
::anticollider::genveto $::anticollider::prog
|
||||
foreach motor [array names veto_region] {
|
||||
anticollision register $motor
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
publish ::anticollider::acscript user
|
||||
anticollision script ::anticollider::acscript
|
||||
85
site_ansto/instrument/config/commands/commands_common.tcl
Normal file
85
site_ansto/instrument/config/commands/commands_common.tcl
Normal file
@@ -0,0 +1,85 @@
|
||||
##
|
||||
# @file Definition of common command node procs.
|
||||
|
||||
################################################################################
|
||||
# SCAN COMMANDS
|
||||
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 $scan_variable $scan_start $scan_increment
|
||||
bmonscan setchannel $channel;
|
||||
set status [catch {bmonscan run $NP $mode $preset} msg]
|
||||
# bmonscan configure soft
|
||||
if {$status == 0} {
|
||||
return $msg
|
||||
} else {
|
||||
return -code error "ERROR [info level 0]"
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
::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
|
||||
|
||||
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 {
|
||||
return -code error "ERROR [info level 0]"
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
::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
|
||||
}
|
||||
sicslist setatt ::scan::hdb_bmonscan long_name bmonscan
|
||||
sicslist setatt ::scan::hdb_hmscan long_name hmscan
|
||||
################################################################################
|
||||
|
||||
################################################################################
|
||||
# MONITOR COMMANDS
|
||||
namespace eval monitor {
|
||||
command count {
|
||||
text=timer,monitor mode
|
||||
float preset
|
||||
} {
|
||||
::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
|
||||
}
|
||||
::monitor::count -addfb int counts text status
|
||||
::monitor::count -set feedback status IDLE
|
||||
array set fbarr [::monitor::count -list feedback]
|
||||
::utility::mkData $fbarr(counts) data monitor privilege user mutable true
|
||||
array unset fbarr
|
||||
}
|
||||
################################################################################
|
||||
@@ -1,20 +1,2 @@
|
||||
#FIXME Nexus path info is coded into this source. This means that if you change the
|
||||
# monitor data path in the config/hipadaba/common_instrument_dictionary.tcl then
|
||||
# you may also need to change the paths here
|
||||
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
|
||||
}
|
||||
::monitor::count -addfb int counts text status
|
||||
::monitor::count -set feedback status IDLE
|
||||
array set fbarr [::monitor::count -list feedback]
|
||||
::utility::mkData $fbarr(counts) data monitor privilege user mutable true
|
||||
array unset fbarr
|
||||
}
|
||||
|
||||
@@ -0,0 +1,28 @@
|
||||
namespace eval ::environment::temperature { }
|
||||
|
||||
# @brief Make a simulated temperature controller object.
|
||||
#
|
||||
# @param temp_sobj, name for temperature controller object.
|
||||
proc ::environment::temperature::mkls340sim {temp_sobj} {
|
||||
EvFactory new $temp_sobj sim
|
||||
sicslist setatt $temp_sobj numsensors 4
|
||||
sicslist setatt $temp_sobj controlsensor sensora
|
||||
sicslist setatt $temp_sobj sensorlist sensora,sensorb,sensorc,sensord
|
||||
sicslist setatt $temp_sobj heateron 1
|
||||
sicslist setatt $temp_sobj range 2
|
||||
sicslist setatt $temp_sobj units kelvin
|
||||
sicslist setatt $temp_sobj klass @none
|
||||
}
|
||||
|
||||
# @brief Make a lakeshore340 temperature controller object.
|
||||
#
|
||||
# @param temp_sobj, name for temperature controller object
|
||||
# @param IP, (optional) IP address for temperature controller.
|
||||
# @param port, (optional) port number for temperature controller.
|
||||
proc ::environment::temperature::mkls340 {temp_sobj {IP 137.157.201.50} {port 4001}} {
|
||||
Makeasyncqueue sertemp1 LS340 $IP $port
|
||||
sertemp1 timeout 2000
|
||||
EvFactory new $temp_sobj ls340 sertemp1 1 D ABCD
|
||||
sicslist setatt $temp_sobj units kelvin
|
||||
sicslist setatt $temp_sobj klass @none
|
||||
}
|
||||
@@ -32,11 +32,107 @@ set instrument_dictionary [subst {
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXinstrument type instrument}
|
||||
}
|
||||
instrument/status {
|
||||
instrument/aperture {
|
||||
privilege spy
|
||||
sobj {@any plc}
|
||||
sobj {@any aperture}
|
||||
datatype @none
|
||||
property {data false control true nxsave false klass @none type part}
|
||||
property {data true control true nxsave false klass NXaperture type part}
|
||||
}
|
||||
instrument/attenuator {
|
||||
privilege spy
|
||||
sobj {@any attenuator}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXattenuator type part}
|
||||
}
|
||||
instrument/beam_stop {
|
||||
privilege spy
|
||||
sobj {@any beam_stop}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXbeam_stop type part}
|
||||
}
|
||||
instrument/bending_magnet {
|
||||
privilege spy
|
||||
sobj {@any bending_magnet}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXbending_magnet type part}
|
||||
}
|
||||
instrument/crystal {
|
||||
privilege spy
|
||||
sobj {@any crystal}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXcrystal type part}
|
||||
}
|
||||
instrument/disk_chopper {
|
||||
privilege spy
|
||||
sobj {@any disk_chopper}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXdisk_chopper type part}
|
||||
}
|
||||
instrument/fermi_chopper {
|
||||
privilege spy
|
||||
sobj {@any fermi_chopper}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXfermi_chopper type part}
|
||||
}
|
||||
instrument/filter {
|
||||
privilege spy
|
||||
sobj {@any filter}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXfilter type part}
|
||||
}
|
||||
instrument/flipper {
|
||||
privilege spy
|
||||
sobj {@any flipper}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXflipper type part}
|
||||
}
|
||||
instrument/guide {
|
||||
privilege spy
|
||||
sobj {@any guide}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXguide type part}
|
||||
}
|
||||
instrument/insertion_device {
|
||||
privilege spy
|
||||
sobj {@any insertion_device}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXinsertion_device type part}
|
||||
}
|
||||
instrument/mirror {
|
||||
privilege spy
|
||||
sobj {@any mirror}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXmirror type part}
|
||||
}
|
||||
instrument/moderator {
|
||||
privilege spy
|
||||
sobj {@any moderator}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXmoderator type part}
|
||||
}
|
||||
instrument/polarizer {
|
||||
privilege spy
|
||||
sobj {@any polarizer}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXpolarizer type part}
|
||||
}
|
||||
instrument/positioner {
|
||||
privilege spy
|
||||
sobj {@any positioner}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXpositioner type part}
|
||||
}
|
||||
instrument/source {
|
||||
privilege spy
|
||||
sobj {@any source}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXsource type part}
|
||||
}
|
||||
instrument/velocity_selector {
|
||||
privilege spy
|
||||
sobj {@any velocity_selector}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXvelocity_selector type part}
|
||||
}
|
||||
instrument/detector {
|
||||
privilege spy
|
||||
@@ -44,29 +140,17 @@ set instrument_dictionary [subst {
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXdetector type part}
|
||||
}
|
||||
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}
|
||||
}
|
||||
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}
|
||||
sobj {@any monochromator}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXcrystal type part}
|
||||
property {data true control true nxsave false klass NXmonochromator type part}
|
||||
}
|
||||
instrument/slits {
|
||||
privilege spy
|
||||
@@ -74,17 +158,17 @@ set instrument_dictionary [subst {
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXfilter type part}
|
||||
}
|
||||
user {
|
||||
sample {
|
||||
privilege spy
|
||||
sobj {@any user}
|
||||
sobj {@any sample @any environment}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXuser type part}
|
||||
property {data true control true nxsave false klass NXsample type part}
|
||||
}
|
||||
experiment {
|
||||
monitor {
|
||||
privilege spy
|
||||
sobj {@any experiment}
|
||||
sobj {@any monitor}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXnote type part}
|
||||
property {data true control true nxsave false klass NXmonitor type part}
|
||||
}
|
||||
data {
|
||||
privilege spy
|
||||
@@ -92,6 +176,43 @@ set instrument_dictionary [subst {
|
||||
datatype @none
|
||||
property {data true control false nxsave false klass NXdata type part datatype UNKNOWN currentfiletype UNKNOWN}
|
||||
}
|
||||
event_data {
|
||||
privilege spy
|
||||
sobj {@any event_data}
|
||||
datatype @none
|
||||
property {data true control false nxsave false klass NXevent_data type part datatype UNKNOWN currentfiletype UNKNOWN}
|
||||
}
|
||||
user {
|
||||
privilege spy
|
||||
sobj {@any user}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXuser type part}
|
||||
}
|
||||
process {
|
||||
privilege spy
|
||||
sobj {@any process}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXprocess type part}
|
||||
}
|
||||
characterization {
|
||||
privilege spy
|
||||
sobj {@any characterization}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXcharacterization type part}
|
||||
}
|
||||
|
||||
experiment {
|
||||
privilege spy
|
||||
sobj {@any experiment}
|
||||
datatype @none
|
||||
property {data true control true nxsave false klass NXnote type part}
|
||||
}
|
||||
instrument/status {
|
||||
privilege spy
|
||||
sobj {@any plc}
|
||||
datatype @none
|
||||
property {data false control true nxsave false klass @none type part}
|
||||
}
|
||||
data/data_set {
|
||||
privilege spy
|
||||
datatype @none
|
||||
|
||||
@@ -15,8 +15,384 @@ InstallHdb
|
||||
|
||||
namespace eval ::hdb {
|
||||
namespace export buildHDB attlist
|
||||
|
||||
set NXlog_template {
|
||||
NXlog {
|
||||
$name {
|
||||
$paramarr(time)
|
||||
$paramarr(value)
|
||||
$paramarr(raw_value)
|
||||
$paramarr(description)
|
||||
$paramarr(average_value)
|
||||
$paramarr(average_value_error)
|
||||
$paramarr(minimum_value)
|
||||
$paramarr(maximum_value)
|
||||
$paramarr(duration)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
set NXnote_template {
|
||||
NXnote {
|
||||
$name {
|
||||
$paramarr(author)
|
||||
$paramarr(date)
|
||||
$paramarr(type)
|
||||
$paramarr(file_name)
|
||||
$paramarr(description)
|
||||
$paramarr(data)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
set NXbeam_template {
|
||||
$name {
|
||||
$paramarr(distance)
|
||||
$paramarr(incident_energy)
|
||||
$paramarr(final_energy)
|
||||
$paramarr(energy_transfer)
|
||||
$paramarr(incident_wavelength)
|
||||
$paramarr(incident_wavelength_spread)
|
||||
$paramarr(incident_beam_divergence)
|
||||
$paramarr(final_wavelength)
|
||||
$paramarr(incident_polarization)
|
||||
$paramarr(final_polarization)
|
||||
$paramarr(final_wavelength_spread)
|
||||
$paramarr(final_beam_divergence)
|
||||
$paramarr(flux)
|
||||
}
|
||||
}
|
||||
|
||||
# NOTE: paramarr(offset) was added for Quokka's DetPosYOffsetmm parameter
|
||||
set NXgeometry_template {
|
||||
NXgeometry {
|
||||
geometry {
|
||||
sobjlist {$paramarr(geomdescription)}
|
||||
NXshape {
|
||||
shape {
|
||||
sobjlist {$paramarr(shape) $paramarr(size)}
|
||||
}
|
||||
}
|
||||
NXtranslation {
|
||||
position {
|
||||
sobjlist {$paramarr(position) $paramarr(offset) $paramarr(coordinate_scheme)}
|
||||
NXgeometry {
|
||||
geometry {
|
||||
link {
|
||||
target {$paramarr(refpos)}
|
||||
nxalias {$paramarr(position)}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
NXorientation {
|
||||
orientation {
|
||||
sobjlist {$paramarr(orientation)}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
set NXaperture_template [subst -novariables {
|
||||
NXaperture {
|
||||
$name {
|
||||
sobjlist {$paramarr(material) $paramarr(description)}
|
||||
[ set NXgeometry_template ]
|
||||
}
|
||||
}
|
||||
} ]
|
||||
|
||||
set NXvelocity_selector_template [subst -novariables {
|
||||
NXvelocity_selector {
|
||||
$name {
|
||||
sobjlist {
|
||||
$paramarr(type)
|
||||
$paramarr(rotation_speed)
|
||||
$paramarr(radius)
|
||||
$paramarr(spwidth)
|
||||
$paramarr(length)
|
||||
$paramarr(num)
|
||||
$paramarr(twist)
|
||||
$paramarr(table)
|
||||
$paramarr(height)
|
||||
$paramarr(width)
|
||||
$paramarr(wavelength)
|
||||
$paramarr(wavelength_spread)
|
||||
}
|
||||
[ set NXgeometry_template ]
|
||||
}
|
||||
}
|
||||
} ]
|
||||
}
|
||||
|
||||
proc ::hdb::MakeLog {name klass paramlist} {
|
||||
variable NXlog_template
|
||||
array set paramarr $paramlist
|
||||
set newtable [list]
|
||||
prune_NX newtable $NXlog_template
|
||||
::hdb::subtree_macro $name $klass $newtable
|
||||
}
|
||||
proc ::hdb::MakeNote {name klass paramlist} {
|
||||
variable NXnote_template
|
||||
array set paramarr $paramlist
|
||||
set newtable [list]
|
||||
prune_NX newtable $NXnote_template
|
||||
::hdb::subtree_macro $name $klass $newtable
|
||||
}
|
||||
proc ::hdb::MakeBeam {name klass paramlist} {
|
||||
variable NXbeam_template
|
||||
array set paramarr $paramlist
|
||||
set newtable [list]
|
||||
prune_NX newtable $NXbeam_template
|
||||
::hdb::subtree_macro $name $klass $newtable
|
||||
}
|
||||
|
||||
proc ::hdb:MakeEnvironment {name klass paramlist} {
|
||||
variable NXenvironment_template
|
||||
array set paramarr $paramlist
|
||||
set newtable [list]
|
||||
prune_NX newtable $NXenvironment_template
|
||||
::hdb::subtree_macro $name $klass $newtable
|
||||
}
|
||||
|
||||
proc ::hdb::MakeGeometry {name klass paramlist} {
|
||||
variable NXgeometry_template
|
||||
array set paramarr $paramlist
|
||||
set newtable [list]
|
||||
prune_NX newtable $NXgeometry_template
|
||||
::hdb::subtree_macro $name $klass $newtable
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Generates an hdb subtree macro from a named list of SICS objects.
|
||||
#
|
||||
# NOTE: Currently the only SICS objects supported are 'sicsvariable' and 'macro'.
|
||||
# @param name, This is the name of the aperture.
|
||||
# @paramlist, A name value list of aperture parameters. All parameters are optional.
|
||||
proc ::hdb::MakeAperture {name paramlist} {
|
||||
array set paramarr $paramlist
|
||||
variable NXaperture_template
|
||||
set newtable [list]
|
||||
prune_NX newtable $NXaperture_template
|
||||
::hdb::subtree_macro $name instrument $newtable
|
||||
}
|
||||
|
||||
proc ::hdb::MakeVelocity_Selector {name paramlist} {
|
||||
variable NXvelocity_selector_template
|
||||
array set paramarr $paramlist
|
||||
set newtable [list]
|
||||
prune_NX newtable $NXvelocity_selector_template
|
||||
::hdb::subtree_macro $name instrument $newtable
|
||||
}
|
||||
|
||||
##
|
||||
# @brief This simplifies a NeXus-class template by removing unnecessary branches.
|
||||
# A NeXus-class template is a keyed-list which has Tcl variables for some of the nodes,
|
||||
# if the Tcl variables aren't defined for some branch then that branch is removed.
|
||||
# All other variables are expanded in place, also all 'sobjlists' are split up into type
|
||||
# specific lists. This is intended as a helper function for commands which generate
|
||||
# NeXus-class keyed lists from a simple set of optional parameters.
|
||||
#
|
||||
# @param NXklist, This is a keyed list representation of the NeXus class which will be augmented
|
||||
# with the pruned nx_template. Note this can just be an empty list.
|
||||
# @param nx_template, The NeXus-class template which will be pruned.
|
||||
# @param path, (optional, default="") Parent path in recursive calls.
|
||||
# @param node, (optional, default="") Current node in recursive calls.
|
||||
# @param level, (optional,default=1) The location of the template parameters in the callstack.
|
||||
proc prune_NX {NXklist nx_template {path ""} {node ""} {level 1}} {
|
||||
upvar $NXklist newtable
|
||||
# puts "[info level 0]\nCallstack depth = [info level]\nRecursion depth = [expr $level-1]"
|
||||
if {$path == ""} {
|
||||
set currpath $node
|
||||
} else {
|
||||
set currpath $path/$node
|
||||
}
|
||||
foreach {n v} $nx_template {
|
||||
switch $n {
|
||||
"sobjlist" {
|
||||
set has_sobj 0
|
||||
foreach var $v {
|
||||
if {[string index $var 0] == "$"} {
|
||||
set vn [string range $var 1 end]
|
||||
upvar $level $vn lvar
|
||||
if [info exists lvar] {
|
||||
foreach sobj $lvar {
|
||||
lappend [getatt $sobj type]_list $sobj
|
||||
}
|
||||
set has_sobj 1
|
||||
}
|
||||
} else {
|
||||
foreach sobj $var {
|
||||
lappend [getatt $sobj type]_list $sobj
|
||||
}
|
||||
set has_sobj 1
|
||||
}
|
||||
}
|
||||
if {$has_sobj} {
|
||||
if [info exists sicsvariable_list] {
|
||||
::utility::tabset newtable $currpath/sicsvariable [subst {{$sicsvariable_list}}]
|
||||
}
|
||||
if [info exists macro_list] {
|
||||
::utility::tabset newtable $currpath/macro [subst {{$macro_list}}]
|
||||
}
|
||||
} else {
|
||||
}
|
||||
}
|
||||
"link" {
|
||||
set linktarget ""
|
||||
array set linkinfo $v
|
||||
if {[string index $linkinfo(target) 0] == "$"} {
|
||||
set vn [string range $linkinfo(target) 1 end]
|
||||
upvar $level $vn lvar
|
||||
if [info exists lvar] {
|
||||
set linktarget $lvar
|
||||
}
|
||||
} else {
|
||||
set linktarget $linkinfo(target)
|
||||
}
|
||||
if {[string index $linkinfo(nxalias) 0] == "$"} {
|
||||
set vn [string range $linkinfo(nxalias) 1 end]
|
||||
upvar $level $vn avar
|
||||
if [info exists avar] {
|
||||
set linkname $avar
|
||||
}
|
||||
} else {
|
||||
set linkname $linkinfo(nxalias)
|
||||
}
|
||||
if {$linktarget != ""} {
|
||||
::utility::tabset newtable $currpath/link/target [subst {{$linktarget}}]
|
||||
::utility::tabset newtable $currpath/link/nxalias [subst {{$linkname}}]
|
||||
}
|
||||
}
|
||||
default {
|
||||
if {[string range $n 0 1] == "NX"} {
|
||||
set node $n
|
||||
} elseif {[string index $n 0] == "$"} {
|
||||
set vn [string range $n 1 end]
|
||||
upvar $level $vn lvar
|
||||
if [info exists lvar] {
|
||||
set node $lvar
|
||||
} else {
|
||||
}
|
||||
} else {
|
||||
set node $n
|
||||
}
|
||||
prune_NX newtable $v $currpath $node [expr $level+1]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Make an aperture
|
||||
#
|
||||
# @param args optional name and description variables
|
||||
#proc MakeAperture {apname nxgeometry args} {
|
||||
# set nxaperture [::hdb::NXaperture $apname $nxgeometry $args]
|
||||
# ::hdb::subtree_macro $apname instrument $nxaperture
|
||||
#}
|
||||
|
||||
##
|
||||
# @brief Generate a subtree macro procedure
|
||||
#
|
||||
# @param Name of the subtree macro
|
||||
# @klass Category which the macro belongs to (usually a NeXus class)
|
||||
# @klist A keyed list which describes the subtree.
|
||||
proc ::hdb::subtree_macro {name klass klist} {
|
||||
set st_macroname ${name}_subtree_macro
|
||||
proc ::hdb::$st_macroname {} "return [list $klist]"
|
||||
::hdb::set_subtree_props ::hdb::$st_macroname $klass
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Publish an hdb_subtree macro and initialise it's property list
|
||||
#
|
||||
# @param st_name The name of the hdb_subtree macro
|
||||
# @param klass Where should the subtree be placed in the hdb heirarchy
|
||||
# @param control (optional, default=true) Add it to the control interface?
|
||||
# @param privilege (optional, default=user) Modification privilege.
|
||||
proc ::hdb::set_subtree_props {st_name klass {control "true"} {privilege "user"} } {
|
||||
publish $st_name mugger
|
||||
sicslist setatt $st_name klass $klass
|
||||
sicslist setatt $st_name control $control
|
||||
sicslist setatt $st_name privilege $privilege
|
||||
sicslist setatt $st_name kind "hdb_subtree"
|
||||
sicslist setatt $st_name long_name "@none"
|
||||
sicslist setatt $st_name data "true"
|
||||
sicslist setatt $st_name nxsave "true"
|
||||
}
|
||||
|
||||
# @brief Add a subtree to a given hipadaba path.
|
||||
#
|
||||
# @param hpath, Basepath for subtree
|
||||
# @param object, SICS object name
|
||||
# @param subtree, A nested Tcl list which represents the subtree
|
||||
# @param type, the SICS object type if we are adding SICS object node. Optional, default = @none.
|
||||
# @param makenode, type of node to make. Optional, default = @none.
|
||||
proc ::hdb::add_subtree {hpath subtree {object @none} {type @none} {makenode @none}} {
|
||||
set ::errorInfo ""
|
||||
set SICStypes {sicsvariable macro}
|
||||
if [catch {
|
||||
switch $makenode {
|
||||
"@none" {
|
||||
foreach {n v} $subtree {
|
||||
if {[lsearch -exact $::nexus_classes $n] != -1} {
|
||||
add_subtree $hpath $v $object $n NXclass
|
||||
} elseif {[lsearch -exact $SICStypes $n] != -1} {
|
||||
add_subtree $hpath $v $object $n sicsobject
|
||||
} elseif {$n=="link"} {
|
||||
add_subtree $hpath $v $object $n link
|
||||
} else {
|
||||
error "ERROR:Unknown type, '$n'"
|
||||
}
|
||||
}
|
||||
}
|
||||
"NXclass" {
|
||||
foreach {item val} $subtree {
|
||||
add_hpath $hpath $item
|
||||
hsetprop $hpath/$item klass $type
|
||||
add_subtree $hpath/$item $val $object
|
||||
}
|
||||
}
|
||||
"sicsobject" {
|
||||
foreach item $subtree {
|
||||
if {$item==$object} {
|
||||
error "ERROR: Infinite recursion, cannot add $item as a node to it's own hdb subtree"
|
||||
}
|
||||
set objtype [getatt $item type]
|
||||
if {$type != $objtype} {
|
||||
error "ERROR: Specified type of '$type' doesn't match actual type, '$objtype', for $item"
|
||||
}
|
||||
sobjadd $hpath $item
|
||||
}
|
||||
}
|
||||
"link" {
|
||||
set target [::utility::tabget subtree target]
|
||||
set nxalias [::utility::tabget subtree nxalias]
|
||||
foreach l $nxalias t $target {
|
||||
set refname [getatt $t long_name]
|
||||
::hdb::add_hpath $hpath $refname
|
||||
hsetprop $hpath/$refname data "true"
|
||||
hsetprop $hpath/$refname nxsave "false"
|
||||
hsetprop $hpath/$refname control "false"
|
||||
|
||||
hsetprop $hpath/$refname link $t
|
||||
hsetprop $hpath/$refname nxalias ${l}_posref
|
||||
hsetprop $hpath/$refname type nxvgroup
|
||||
hsetprop $hpath/$refname klass @none
|
||||
}
|
||||
}
|
||||
default {
|
||||
error "ERROR: Unknown node type, $makenode"
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $hpath}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
##
|
||||
# @brief Add an hdb path to the hdb tree at the given basePath
|
||||
#
|
||||
@@ -87,103 +463,113 @@ proc ::hdb::add_feedback {hpath sobj name} {
|
||||
proc ::hdb::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
|
||||
if [ catch {
|
||||
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)
|
||||
}
|
||||
# }
|
||||
return $node_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
|
||||
array set attribute [attlist $node_name]
|
||||
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 ::hdb::add_cmd_par $cmd_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
|
||||
array set attribute [attlist $node_name]
|
||||
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 ::hdb::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 ::hdb::add_feedback $cmd_path/feedback
|
||||
}
|
||||
}
|
||||
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 ::hdb::add_feedback $cmd_path/feedback
|
||||
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 mutable [getatt $node_name mutable]
|
||||
hsetprop $node_path klass [getatt $node_name klass]
|
||||
if [info exists attribute(hdbchain)] {
|
||||
foreach pmot [split $attribute(hdbchain) ,] {
|
||||
hchain $node_path [getatt $pmot hdb_path]
|
||||
}
|
||||
}
|
||||
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]
|
||||
}
|
||||
}
|
||||
script - getset {
|
||||
# A r/w pair of scripts, node = a node path
|
||||
set node_path $basePath/[getatt $node_name long_name]
|
||||
set data_type [getatt $node_name dtype]
|
||||
set data_length [getatt $node_name dlen]
|
||||
if {[getatt $node_name access] == "read_only"} {
|
||||
hmakescript $node_path $node_name hdbReadOnly $data_type $data_length
|
||||
} else {
|
||||
hmakescript $node_path $node_name $node_name $data_type $data_length
|
||||
}
|
||||
hsetprop $node_path sicsdev $node_name
|
||||
hsetprop $node_path nxalias $node_name
|
||||
hsetprop $node_path data [getatt $node_name data]
|
||||
hsetprop $node_path control [getatt $node_name control]
|
||||
hsetprop $node_path klass [getatt $node_name klass]
|
||||
hsetprop $node_path sdsinfo [getatt $node_name sdsinfo]
|
||||
hsetprop $node_path savecmd [getatt $node_name savecmd]
|
||||
#hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen)
|
||||
}
|
||||
}
|
||||
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]
|
||||
if {[info exists attribute(units)]} {
|
||||
hsetprop $node_path units $attribute(units)
|
||||
}
|
||||
if {[info exists arg_array(prop_list)]} {
|
||||
foreach {prop pval} $arg_array(prop_list) {
|
||||
hsetprop $node_path $prop $pval
|
||||
}
|
||||
}
|
||||
script {
|
||||
# A r/w pair of scripts, node = a node path
|
||||
set node_path $basePath/[getatt $node_name long_name]
|
||||
set data_type [getatt $node_name dtype]
|
||||
set data_length [getatt $node_name dlen]
|
||||
if {[getatt $node_name access] == "read_only"} {
|
||||
hmakescript $node_path $node_name hdbReadOnly $data_type $data_length
|
||||
} else {
|
||||
hmakescript $node_path $node_name $node_name $data_type $data_length
|
||||
}
|
||||
hsetprop $node_path sicsdev $node_name
|
||||
hsetprop $node_path nxalias $node_name
|
||||
hsetprop $node_path data true
|
||||
hsetprop $node_path control false
|
||||
hsetprop $node_path klass [getatt $node_name klass]
|
||||
hsetprop $node_path sdsinfo [getatt $node_name sdsinfo]
|
||||
hsetprop $node_path savecmd [getatt $node_name savecmd]
|
||||
#hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen)
|
||||
}
|
||||
sicslist setatt $node_name hdb_path $node_path
|
||||
return $node_path
|
||||
}
|
||||
if {[info exists attribute(units)]} {
|
||||
hsetprop $node_path units $attribute(units)
|
||||
}
|
||||
if {[info exists arg_array(prop_list)]} {
|
||||
foreach {prop pval} $arg_array(prop_list) {
|
||||
hsetprop $node_path $prop $pval
|
||||
}
|
||||
}
|
||||
sicslist setatt $node_name hdb_path $node_path
|
||||
return $node_path
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
@@ -218,10 +604,15 @@ proc ::hdb::add_command {basePath command} {
|
||||
# @param sicsobj SICS object name
|
||||
# @return a list of name value pairs for the sicsobj attributes
|
||||
proc ::hdb::attlist {sicsobj} {
|
||||
foreach att [tolower_sicslist $sicsobj] {
|
||||
lappend atts [split [string range $att 0 end-1] =]
|
||||
if [ catch {
|
||||
foreach att [tolower_sicslist $sicsobj] {
|
||||
lappend atts [split [string range $att 0 end-1] =]
|
||||
}
|
||||
return [join $atts]
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
return [join $atts]
|
||||
}
|
||||
|
||||
|
||||
@@ -273,109 +664,108 @@ proc ::hdb::sobjadd {hpath sobj args} {
|
||||
# TODO Check if args parameter needs to be here, it might be there in case the function is called
|
||||
# with more than two arguments.
|
||||
array unset sobjatt
|
||||
array set sobjatt [attlist $sobj]
|
||||
sicslist setatt $sobj id $sobj
|
||||
switch $sobjatt(type) {
|
||||
motor - configurablevirtualmotor {
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
|
||||
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
|
||||
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
} else {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
}
|
||||
}
|
||||
macro {
|
||||
# access attribute = ro,rw
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
} else {
|
||||
set node_path [add_node $hpath kind $sobjatt(kind) node $sobj priv $sobjatt(privilege) ]
|
||||
if [info exists sobjatt(mutable)] {
|
||||
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
if [ catch {
|
||||
array set sobjatt [attlist $sobj]
|
||||
sicslist setatt $sobj id $sobj
|
||||
switch $sobjatt(type) {
|
||||
motor - configurablevirtualmotor {
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
}
|
||||
}
|
||||
sicsvariable {
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
|
||||
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
|
||||
if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path privilege $sobjatt(privilege)} err]} {clientput $err error}
|
||||
} else {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
}
|
||||
}
|
||||
node {
|
||||
}
|
||||
singlecounter {
|
||||
# TODO
|
||||
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
|
||||
}
|
||||
histmem {
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
|
||||
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
|
||||
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
|
||||
} else {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
}
|
||||
} else {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
}
|
||||
}
|
||||
macro {
|
||||
# access attribute = ro,rw
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
} elseif {$sobjatt(kind) == "hdb_subtree"} {
|
||||
add_subtree $hpath [$sobj]
|
||||
} else {
|
||||
set node_path [add_node $hpath kind $sobjatt(kind) node $sobj priv $sobjatt(privilege) ]
|
||||
if [info exists sobjatt(mutable)] {
|
||||
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
}
|
||||
}
|
||||
}
|
||||
sicsvariable {
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
|
||||
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
|
||||
if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path privilege $sobjatt(privilege)} err]} {clientput $err error}
|
||||
} else {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
}
|
||||
}
|
||||
node {
|
||||
}
|
||||
singlecounter {
|
||||
# TODO
|
||||
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
|
||||
}
|
||||
histmem {
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
|
||||
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
|
||||
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
|
||||
} 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"
|
||||
}
|
||||
environment_controller {
|
||||
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
|
||||
}
|
||||
}
|
||||
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"
|
||||
}
|
||||
environment_controller {
|
||||
if {[info exists sobjatt(group)]} {
|
||||
set hpath [add_hpath $hpath $sobjatt(group)]
|
||||
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
|
||||
}
|
||||
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
|
||||
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
|
||||
if {[catch { hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
|
||||
if {[catch { hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
|
||||
if {[catch { hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
|
||||
if {[catch { hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
hmakescript $node_path/target "$sobj target" hdbReadOnly float
|
||||
hsetprop $node_path/target data false
|
||||
hsetprop $node_path/target control true
|
||||
} else {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
}
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
proc ::hdb::write_poll {pollnode val} {
|
||||
hsetprop $pollnode poll_interval $val
|
||||
sicspoll intervall $pollnode $val
|
||||
}
|
||||
proc ::hdb::read_poll {pollnode} {
|
||||
return [getatt $pollnode]
|
||||
}
|
||||
|
||||
##
|
||||
@@ -388,12 +778,17 @@ proc ::hdb::sobjadd {hpath sobj args} {
|
||||
# @param given_klass A klass in instdict_specification.tcl
|
||||
# @see sobjadd
|
||||
proc ::hdb::sobjtypeadd {hpath sobjtype given_klass} {
|
||||
foreach {sobj} [sobjlist $sobjtype $given_klass] {
|
||||
array unset sobjatt
|
||||
array set sobjatt [attlist $sobj]
|
||||
if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} {
|
||||
sobjadd $hpath $sobj
|
||||
if [ catch {
|
||||
foreach {sobj} [sobjlist $sobjtype $given_klass] {
|
||||
array unset sobjatt
|
||||
array set sobjatt [attlist $sobj]
|
||||
if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} {
|
||||
sobjadd $hpath $sobj
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
@@ -453,18 +848,23 @@ proc ::hdb::prune {instdict} {
|
||||
proc ::hdb::buildHDB {instDict} {
|
||||
#TODO add data control nxsave nxtyp properties
|
||||
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) {
|
||||
if [ catch {
|
||||
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
|
||||
}
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -11,14 +11,15 @@ set boolean {true false}
|
||||
#}
|
||||
|
||||
# SICS OBJECTS MUST PROVIDE THE FOLLOWING INFORMATION
|
||||
set sobj_klass_list {@none aperture attenuator collimator command crystal data detector entry experiment graphics instrument monitor monochromator plc sample scan user}
|
||||
set sobj_klass_list {@none aperture attenuator collimator command crystal data detector entry environment experiment graphics instrument monitor monochromator plc sample scan sensor user}
|
||||
set sobj_sicstype_list {environment_controller 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.
|
||||
# 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 hobj script}
|
||||
# hdb_subtree: Is a macro which returns a keyed list that describes a hdb subtree.
|
||||
set sobj_kind_list {command hobj script hdb_subtree}
|
||||
set sobj_interfacelist [subst {drivable {$boolean} countable {$boolean} callback {$boolean} environment {$boolean} }]
|
||||
|
||||
set privilege_list {spy user manager read_only internal}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -9,33 +9,36 @@ namespace eval histogram_memory {
|
||||
# requires detector_active_width_mm det_radius_mm deg_per_rad
|
||||
proc two_theta {args} {
|
||||
variable state
|
||||
set opt [lindex $args 0]
|
||||
set arglist [lrange $args 1 end]
|
||||
set proc_name [namespace origin [lindex [info level 0] 0]]
|
||||
set det_width_mm [SplitReply [detector_active_width_mm]]
|
||||
set det_radius_mm [SplitReply [detector_radius_mm]]
|
||||
set deg_per_radian [SplitReply [deg_per_rad]]
|
||||
switch -- $opt {
|
||||
"-centres" - "-boundaries" - "-graph_type" {
|
||||
return [calc_axis $proc_name @none @none @none $opt $args]
|
||||
}
|
||||
"-arrayname" {
|
||||
set max_b [OAT_TABLE -get X_MAX]
|
||||
set min_b [OAT_TABLE -get X_MIN]
|
||||
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}]
|
||||
set offset [::histogram_memory::detector_posn_degrees]
|
||||
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $opt $arglist]
|
||||
}
|
||||
"-units" {
|
||||
return "degrees"
|
||||
}
|
||||
default {
|
||||
set max_b [OAT_TABLE -get X_MAX]
|
||||
set min_b [OAT_TABLE -get X_MIN]
|
||||
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}]
|
||||
set offset [::histogram_memory::detector_posn_degrees]
|
||||
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $args]
|
||||
if [ catch {
|
||||
set opt [lindex $args 0]
|
||||
set arglist [lrange $args 1 end]
|
||||
set proc_name [namespace origin [lindex [info level 0] 0]]
|
||||
set det_width_mm [SplitReply [detector_active_width_mm]]
|
||||
set det_radius_mm [SplitReply [detector_radius_mm]]
|
||||
set deg_per_radian [SplitReply [deg_per_rad]]
|
||||
switch -- $opt {
|
||||
"-centres" - "-boundaries" - "-graph_type" {
|
||||
return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args]
|
||||
}
|
||||
"-arrayname" {
|
||||
set max_chan [OAT_TABLE X -getdata MAX_CHAN]
|
||||
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}]
|
||||
set offset [::histogram_memory::detector_posn_degrees]
|
||||
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist]
|
||||
}
|
||||
"-units" {
|
||||
return "degrees"
|
||||
}
|
||||
default {
|
||||
set max_chan [OAT_TABLE X -getdata MAX_CHAN]
|
||||
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}]
|
||||
set offset [::histogram_memory::detector_posn_degrees]
|
||||
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args]
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
set script_name ::histogram_memory::two_theta
|
||||
|
||||
@@ -5,8 +5,16 @@
|
||||
|
||||
MakeNXScript
|
||||
sicsdatafactory new nxscript_data
|
||||
#mkVar name type access long_name nxsave klass control data
|
||||
::utility::mkVar start_seconds int user start_seconds false entry false false
|
||||
::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
|
||||
sicslist setatt data_run_number mutable true
|
||||
sicslist setatt timestamp mutable true
|
||||
sicslist setatt timestamp units seconds
|
||||
|
||||
namespace eval nexus {
|
||||
variable data_gp_path "/data"
|
||||
set exports [list newfile closefile save data]
|
||||
@@ -32,12 +40,12 @@ namespace eval nexus {
|
||||
# TODO Put the filetype_spec in a separate file.
|
||||
variable filetype_spec {
|
||||
BEAM_MONITOR {
|
||||
link {axis 1 ::data::gumtree_save_par_run_number}
|
||||
link {axis 1 data_run_number}
|
||||
link {data_set ::monitor::count_fb_counts}
|
||||
save_policy {include @all exclude {hmm hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
|
||||
}
|
||||
HISTOGRAM_XYT {
|
||||
link {axis 1 ::data::gumtree_save_par_run_number}
|
||||
link {axis 1 data_run_number}
|
||||
link {axis 2 ::histogram_memory::time_channel}
|
||||
link {axis 3 ::histogram_memory::vertical_axis}
|
||||
link {axis 4 ::histogram_memory::horizontal_axis}
|
||||
@@ -45,40 +53,40 @@ namespace eval nexus {
|
||||
save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
|
||||
}
|
||||
HISTOGRAM_XY {
|
||||
link {axis 1 ::data::gumtree_save_par_run_number}
|
||||
link {axis 1 data_run_number}
|
||||
link {axis 2 ::histogram_memory::vertical_axis}
|
||||
link {axis 3 ::histogram_memory::horizontal_axis}
|
||||
link {data_set hmm_xy}
|
||||
save_policy {include @all exclude {hmm hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
|
||||
}
|
||||
HISTOGRAM_XT {
|
||||
link {axis 1 ::data::gumtree_save_par_run_number}
|
||||
link {axis 1 data_run_number}
|
||||
link {axis 2 ::histogram_memory::time_channel}
|
||||
link {axis 3 ::histogram_memory::horizontal_axis}
|
||||
link {data_set hmm_xt}
|
||||
save_policy {include @all exclude {hmm_xy hmm hmm_yt hmm_x hmm_y hmm_t}}
|
||||
}
|
||||
HISTOGRAM_YT {
|
||||
link {axis 1 ::data::gumtree_save_par_run_number}
|
||||
link {axis 1 data_run_number}
|
||||
link {axis 2 ::histogram_memory::time_channel}
|
||||
link {axis 3 ::histogram_memory::vertical_axis}
|
||||
link {data_set hmm_yt}
|
||||
save_policy {include @all exclude {hmm_xy hmm_xt hmm hmm_x hmm_y hmm_t}}
|
||||
}
|
||||
HISTOGRAM_X {
|
||||
link {axis 1 ::data::gumtree_save_par_run_number}
|
||||
link {axis 1 data_run_number}
|
||||
link {axis 2 ::histogram_memory::horizontal_axis}
|
||||
link {data_set hmm_x}
|
||||
save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm hmm_y hmm_t}}
|
||||
}
|
||||
HISTOGRAM_Y {
|
||||
link {axis 1 ::data::gumtree_save_par_run_number}
|
||||
link {axis 1 data_run_number}
|
||||
link {axis 2 ::histogram_memory::vertical_axis}
|
||||
link {data_set hmm_y}
|
||||
save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm hmm_t}}
|
||||
}
|
||||
HISTOGRAM_T {
|
||||
link {axis 1 ::data::gumtree_save_par_run_number}
|
||||
link {axis 1 data_run_number}
|
||||
link {axis 2 ::histogram_memory::time_channel}
|
||||
link {data_set hmm_t}
|
||||
save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm}}
|
||||
@@ -187,25 +195,30 @@ proc newFileName {postfix} {
|
||||
variable nexusdic
|
||||
variable state
|
||||
variable data_gp_path
|
||||
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"
|
||||
}
|
||||
if [ catch {
|
||||
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 file_format [SplitReply [SicsDataPostFix]]
|
||||
array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
|
||||
set nxdict_path [::nexus::gen_nxdict $nexusdic]
|
||||
if {$state(file,namestyle) == "scratch"} {
|
||||
dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
|
||||
} else {
|
||||
sicsdatanumber incr
|
||||
dataFileName [newFileName $file_format]
|
||||
set file_format [SplitReply [SicsDataPostFix]]
|
||||
array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
|
||||
set nxdict_path [::nexus::gen_nxdict $nexusdic]
|
||||
if {$state(file,namestyle) == "scratch"} {
|
||||
dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
|
||||
} else {
|
||||
sicsdatanumber incr
|
||||
dataFileName [newFileName $file_format]
|
||||
}
|
||||
hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype]
|
||||
nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path
|
||||
set state(file,open) false
|
||||
set state(file,new) false
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype]
|
||||
nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path
|
||||
set state(file,open) false
|
||||
set state(file,new) false
|
||||
}
|
||||
|
||||
##
|
||||
@@ -233,10 +246,11 @@ proc ::nexus::isValidFileType {type} {
|
||||
# state(file,open) true state(file,new) false
|
||||
# /data/currentfiletype == UNKNOWN
|
||||
proc ::nexus::newfile {type {namestyle data}} {
|
||||
variable filetype_spec
|
||||
variable state
|
||||
variable data_gp_path
|
||||
variable filetype_spec
|
||||
variable state
|
||||
variable data_gp_path
|
||||
|
||||
if [ catch {
|
||||
set state(file,namestyle) $namestyle
|
||||
set state(file,new) true
|
||||
hsetprop $data_gp_path currentfiletype UNKNOWN
|
||||
@@ -248,7 +262,11 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
} else {
|
||||
::nexus::process_filetype_policy $type filetype_spec
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Save data to the currently open file and then close it.
|
||||
@@ -256,18 +274,29 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
# @param point This is the array index for mutable data elements
|
||||
#
|
||||
# This function provides the top level call to the recursive ::nexus::savetree
|
||||
# function
|
||||
# function, it should only be called by the ::nexus::save command.
|
||||
#
|
||||
# @see ::nexus::savetree
|
||||
# @see ::nexus::save
|
||||
proc ::nexus::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
|
||||
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 != "::nexus::save"} {
|
||||
error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
|
||||
}
|
||||
foreach child [hlist /] {
|
||||
if {[::utility::hgetplainprop /$child data] == "true"} {
|
||||
::nexus::savetree $child $point
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
::nexus::nxclosefile
|
||||
}
|
||||
|
||||
##
|
||||
@@ -282,64 +311,105 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
variable state
|
||||
variable data_gp_path
|
||||
|
||||
if {[string is integer $point] == 0} {
|
||||
error_msg "save index must be an integer"
|
||||
} elseif {$point < 0} {
|
||||
error_msg "save index cannot be negative"
|
||||
}
|
||||
if [ catch {
|
||||
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::gumtree_save -set run_number $point
|
||||
data_run_number $point
|
||||
|
||||
set isNewFile [expr {$state(file,new) == "true"}]
|
||||
set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype]
|
||||
set currDataType [::utility::hgetplainprop $data_gp_path datatype]
|
||||
set dataTypeChanged [expr {$currFileType != $currDataType}]
|
||||
if {$currDataType == "UNKNOWN"} {
|
||||
error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
|
||||
}
|
||||
|
||||
if {$isNewFile || $dataTypeChanged} {
|
||||
set state(file,new) true
|
||||
::nexus::createfile
|
||||
estart [lindex [sicstime] 1]
|
||||
eend [lindex [sicstime] 1]
|
||||
::nexus::save_data $point
|
||||
::nexus::linkdata
|
||||
} else {
|
||||
eend [lindex [sicstime] 1]
|
||||
::nexus::save_data $point
|
||||
}
|
||||
set isNewFile [expr {$state(file,new) == "true"}]
|
||||
set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype]
|
||||
set currDataType [::utility::hgetplainprop $data_gp_path datatype]
|
||||
set dataTypeChanged [expr {$currFileType != $currDataType}]
|
||||
if {$currDataType == "UNKNOWN"} {
|
||||
error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
|
||||
}
|
||||
|
||||
if {$isNewFile || $dataTypeChanged} {
|
||||
set state(file,new) true
|
||||
::nexus::createfile
|
||||
estart [lindex [sicstime] 1]
|
||||
eend [lindex [sicstime] 1]
|
||||
start_seconds [clock seconds]
|
||||
timestamp 0
|
||||
::nexus::nxreopenfile
|
||||
::nexus::save_data $point
|
||||
::nexus::makelinks
|
||||
::nexus::set_plotdata_info
|
||||
::nexus::nxclosefile
|
||||
} else {
|
||||
eend [lindex [sicstime] 1]
|
||||
timestamp [expr {[clock seconds] - [SplitReply [start_seconds]]}]
|
||||
::nexus::nxreopenfile
|
||||
::nexus::save_data $point
|
||||
::nexus::nxclosefile
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
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 {} {
|
||||
global cfPath
|
||||
variable state
|
||||
variable nexusdic
|
||||
if {$state(file,open) == "false"} {
|
||||
nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
|
||||
set state(file,open) true
|
||||
}
|
||||
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 != "::nexus::save"} {
|
||||
error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
|
||||
}
|
||||
if {$state(file,open) == "false"} {
|
||||
nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
|
||||
set state(file,open) true
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $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 {} {
|
||||
variable state
|
||||
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"
|
||||
}
|
||||
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 != "::nexus::save"} {
|
||||
error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
|
||||
}
|
||||
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"
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
##
|
||||
# @brief Records that a given data source should be linked to nexus data target.
|
||||
@@ -439,25 +509,48 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
##
|
||||
# @brief Links data and axis into /data group
|
||||
# @brief Make dataset links
|
||||
#
|
||||
# Sets the "signal" and "axes" attributes on the plottable data
|
||||
proc ::nexus::makelinks {{hpath /}} {
|
||||
if [ catch {
|
||||
foreach child [hlist $hpath] {
|
||||
if {$hpath == "/"} {
|
||||
set newpath /$child
|
||||
} else {
|
||||
set newpath $hpath/$child
|
||||
}
|
||||
# clientput $newpath
|
||||
array set p_arr [::utility::hlistplainprop $newpath]
|
||||
if {$p_arr(data) == "true" && $p_arr(nxsave) == "true"} {
|
||||
if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
|
||||
if {$p_arr(link) != "@none"} {
|
||||
# clientput "Link $p_arr(nxalias) to $p_arr(link)"
|
||||
nxscript makelink $p_arr(nxalias) $p_arr(link)
|
||||
}
|
||||
}
|
||||
::nexus::makelinks $newpath
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
##
|
||||
# @brief Sets the "signal" and "axes" attributes on the plottable data
|
||||
# Also sets the "axis" attribute for each of the axes.
|
||||
proc ::nexus::linkdata {} {
|
||||
proc ::nexus::set_plotdata_info {} {
|
||||
variable data_gp_path
|
||||
|
||||
array unset axes
|
||||
set hpath $data_gp_path
|
||||
::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]
|
||||
@@ -468,7 +561,7 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
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"}
|
||||
default {error "ERROR: [info level -1]->set_plotdata_info, Unsupported data path $hpath/$child"}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -481,7 +574,6 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
}
|
||||
nxscript putattribute $data_set_alias axes [join $axes_list :]
|
||||
}
|
||||
::nexus::nxclosefile
|
||||
}
|
||||
|
||||
##
|
||||
@@ -490,25 +582,31 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
# @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 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]"
|
||||
set ::errorInfo ""
|
||||
if [ catch {
|
||||
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
|
||||
}
|
||||
::nexus::savetree $hpath/$child $pt
|
||||
}
|
||||
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
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
@@ -526,6 +624,7 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
# @see gen_nxdict
|
||||
proc ::nexus::_gen_nxdict {hpath dictPath name nxc} {
|
||||
variable nxdictionary
|
||||
if [ catch {
|
||||
if {[::utility::hgetplainprop /$hpath data] == "false"} {
|
||||
debug_msg "$hpath doesn't have a data property"
|
||||
return
|
||||
@@ -556,6 +655,10 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
set nxdictionary($alias) "$dictPath/NXVGROUP"
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
@@ -566,15 +669,16 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
#
|
||||
# @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
|
||||
set nxdict_path $cfPath(nexus)/$nexusdic
|
||||
proc ::nexus::gen_nxdict {nexusdic} {
|
||||
global cfPath
|
||||
variable nxdictionary
|
||||
if [ catch {
|
||||
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
|
||||
::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass
|
||||
}
|
||||
}
|
||||
set fh [open $nxdict_path w]
|
||||
@@ -586,44 +690,57 @@ proc ::nexus::newfile {type {namestyle data}} {
|
||||
puts $fh "$n = $v"
|
||||
}
|
||||
close $fh
|
||||
return $nxdict_path
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
return $nxdict_path
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Set SICS object attributes which are required for creating nexus data files.
|
||||
proc ::nexus::set_sobj_attributes {} {
|
||||
# SICS commands
|
||||
sicslist setatt nxscript privilege internal
|
||||
# SICS data objects
|
||||
sicslist setatt nxscript_data privilege internal
|
||||
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 kind script] {
|
||||
sicslist setatt $sobj savecmd ::nexus::script::save
|
||||
sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo
|
||||
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 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 ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
@@ -729,7 +846,41 @@ proc ::nexus::motor::sdsinfo {motor data_type args} {
|
||||
return " -type $dtype $units_att $name_att"
|
||||
}
|
||||
}
|
||||
##
|
||||
# @brief Save data from a 'getset macro'
|
||||
#
|
||||
# NOTE: Currently just saves floats
|
||||
namespace eval ::nexus::macro {}
|
||||
proc ::nexus::macro::getset_save {sobj nxalias data_type args} {
|
||||
if {[lindex $args 0] == "point"} {
|
||||
set index [lindex $args 1]
|
||||
nxscript_data clear
|
||||
nxscript_data putfloat 0 [getVal [$sobj] ]
|
||||
nxscript putslab $nxalias [list $index] [list 1] nxscript_data
|
||||
} else {
|
||||
nxscript putfloat $nxalias [SplitReply [$sobj]]
|
||||
}
|
||||
}
|
||||
|
||||
##
|
||||
# @brief Define the scientific data set path for the nexus dictionary.
|
||||
proc ::nexus::macro::getset_sdsinfo {sobj data_type args} {
|
||||
array set param $args
|
||||
array set attribute [attlist $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} {
|
||||
return " -type $dtype -rank 1 -dim {-1} $units_att $name_att"
|
||||
} else {
|
||||
return " -type $dtype $units_att $name_att"
|
||||
}
|
||||
}
|
||||
####
|
||||
proc ::nexus::environment_controller::save {evc nxalias data_type args} {
|
||||
if {[lindex $args 0] == "point"} {
|
||||
set index [lindex $args 1]
|
||||
@@ -806,30 +957,59 @@ proc ::nexus::singlecounter::sdsinfo {counter data_type args} {
|
||||
#
|
||||
# The macro must return a 1D associative array when called with -arrayname.
|
||||
proc ::nexus::script::save {script nxalias data_type args} {
|
||||
array set attribute [attlist $script]
|
||||
set darray [$script -arrayname]
|
||||
set size [array size $darray]
|
||||
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
|
||||
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 {
|
||||
nxscript putslab $nxalias [list 0] [list $size] $darray
|
||||
set darray [$script -arrayname]
|
||||
set size [array size $darray]
|
||||
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 {[info exists attribute(units)]} {
|
||||
nxscript putattribute $nxalias units $attribute(units)
|
||||
}
|
||||
}
|
||||
if {[info exists attribute(units)]} {
|
||||
nxscript putattribute $nxalias units $attribute(units)
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
proc ::nexus::script::sdsinfo {script data_type args} {
|
||||
array set param $args
|
||||
set dtype [::nexus::hdb2nx_type $data_type]
|
||||
set darray [$script -arrayname]
|
||||
set size [SplitReply [$darray used]]
|
||||
if {$param(mutable) == true} {
|
||||
return " -type $dtype -rank 2 -dim {-1,$size}"
|
||||
} else {
|
||||
return " -type $dtype -rank 1 -dim {$size}"
|
||||
if [ catch {
|
||||
array set param $args
|
||||
set dtype [::nexus::hdb2nx_type $data_type]
|
||||
if {[getatt $script klass] == "sensor"} {
|
||||
if {$param(mutable) == true} {
|
||||
return " -type $dtype -rank 1 -dim {-1}"
|
||||
} else {
|
||||
return " -type $dtype"
|
||||
}
|
||||
} else {
|
||||
set darray [$script -arrayname]
|
||||
set size [SplitReply [$darray used]]
|
||||
if {$param(mutable) == true} {
|
||||
return " -type $dtype -rank 2 -dim {-1,$size}"
|
||||
} else {
|
||||
return " -type $dtype -rank 1 -dim {$size}"
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
if {$::errorCode=="NONE"} {return $message}
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
@@ -850,26 +1030,26 @@ foreach expt $::nexus::exports {
|
||||
|
||||
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.35 $}]
|
||||
set tmpstr [string map {"$" ""} {$Revision: 1.36 $}]
|
||||
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]]
|
||||
}
|
||||
#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
|
||||
|
||||
@@ -52,7 +52,9 @@ proc ::scan::check_scanvar {sobj uobj} {
|
||||
set scan_increment [lindex $vlist 2];
|
||||
if {[getatt $scan_variable type] == "motor"} {
|
||||
if {[SplitReply [$scan_variable fixed]] >= 0} {
|
||||
return -code error "Can't drive scan variable, $scan_variable position is set to 'fixed'"
|
||||
return -code error "ERROR: Can't drive scan variable, $scan_variable position is set to 'fixed'"
|
||||
} elseif {[SplitReply [$scan_variable thread0]] == -1} {
|
||||
return -code error "ERROR: Can't scan ${scan_variable}. Thread zero has stopped running on the motion controller"
|
||||
}
|
||||
set target [expr $scan_start + $NP * $scan_increment]
|
||||
if [catch {
|
||||
@@ -130,6 +132,7 @@ proc ::scan::hmm_count {sobj uobj point mode preset} {
|
||||
::histogram_memory::start block
|
||||
}
|
||||
|
||||
#TODO rangescan: drive to original position for rangescans, not the start position.
|
||||
proc ::scan::hmm_scan_finish {sobj uobj} {
|
||||
variable save_filetype
|
||||
variable reset_position
|
||||
@@ -273,50 +276,6 @@ hmscan function count ::scan::hmm_count
|
||||
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 $scan_variable $scan_start $scan_increment
|
||||
bmonscan setchannel $channel;
|
||||
set status [catch {bmonscan run $NP $mode $preset} msg]
|
||||
# bmonscan configure soft
|
||||
if {$status == 0} {
|
||||
return $msg
|
||||
} else {
|
||||
return -code error "ERROR [info level 0]"
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
::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
|
||||
|
||||
|
||||
|
||||
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 {
|
||||
return -code error "ERROR [info level 0]"
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
::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
|
||||
}
|
||||
sicslist setatt ::scan::hdb_bmonscan long_name bmonscan
|
||||
sicslist setatt ::scan::hdb_hmscan long_name hmscan
|
||||
namespace eval scan {
|
||||
namespace export runscan
|
||||
VarMake ::scan::runscan_reset_position Text internal
|
||||
|
||||
Reference in New Issue
Block a user