1732ecdb99
The histmem command now returns clean error messages. Stack traces are displayed for errors which are triggered from the second call level with the histmem command. Made sure that catch blocks don't enclose a 'return' because this triggers the catch to report the contents of errorInfo. Removed obsolete setup procedure. Made sure that uploading of configuration files to the histogram server is only enabled for the 'hmm' object in the ::histogram_memory::upload_config procedure. Uploading config files is disabled for all other histmem objects at all times. r2282 | ffr | 2008-01-15 14:53:47 +1100 (Tue, 15 Jan 2008) | 7 lines
1325 lines
43 KiB
Tcl
1325 lines
43 KiB
Tcl
# $Revision: 1.28 $
|
|
# $Date: 2008-01-15 03:53:47 $
|
|
# Author: Ferdi Franceschini
|
|
# Based on the examples in the hs_test.tcl sample configuration by Mark Lesha.
|
|
# http://gumtree.ansto.gov.au:9080/nbicms/bragg-systems/histogram-server/hs_test.tcl/view
|
|
# Last revision by: $Author: ffr $
|
|
|
|
##
|
|
# @file Provides generic code and parameters for configuring the ANSTO histogram memory server
|
|
# The instrument specific histogram memory configuration files must define an initialisation
|
|
# function with the following signature
|
|
# @code proc ::histogram_memory::initialize {}
|
|
# this function should call the generic initalisation function,
|
|
# ::histogram_memory::_initialize
|
|
#
|
|
#@see ::histogram_memory::_initialize
|
|
set sim_mode [SplitReply [hmm_simulation]]
|
|
if {$sim_mode == "true"} {
|
|
MakeHM hmm SIM
|
|
MakeHM hmm_xy SIM
|
|
MakeHM hmm_xt SIM
|
|
MakeHM hmm_yt SIM
|
|
MakeHM hmm_x SIM
|
|
MakeHM hmm_y SIM
|
|
MakeHM hmm_t SIM
|
|
hmm configure daq Stopped
|
|
hmm configure statuscheck false
|
|
namespace eval histogram_memory {
|
|
proc hmc {_start _preset _mode _pause pauseval} {
|
|
bm mode $_mode;
|
|
bm preset $_preset;
|
|
hmm countblock;
|
|
}
|
|
}
|
|
} else {
|
|
MakeHM hmm anstohttp;
|
|
MakeHM hmm_xy anstohttp;
|
|
MakeHM hmm_xt anstohttp;
|
|
MakeHM hmm_yt anstohttp;
|
|
MakeHM hmm_x anstohttp;
|
|
MakeHM hmm_y anstohttp;
|
|
MakeHM hmm_t anstohttp;
|
|
|
|
MakeHMControl_ANSTO hmc bm hmm;
|
|
}
|
|
|
|
hmm configure rank 3
|
|
hmm_xy configure rank 2
|
|
hmm_xt configure rank 2
|
|
hmm_yt configure rank 2
|
|
hmm_x configure rank 1
|
|
hmm_y configure rank 1
|
|
hmm_t configure rank 1
|
|
|
|
|
|
namespace eval histogram_memory {
|
|
::utility::mkVar detector_active_height_mm Float user active_height true detector true true
|
|
sicslist setatt detector_active_height_mm units mm
|
|
::utility::mkVar detector_active_width_mm Float user active_width true detector true true
|
|
sicslist setatt detector_active_width_mm units mm
|
|
|
|
::utility::mkVar hmm_user_configpath Text manager user_configpath false detector false false
|
|
hmm_user_configpath ../user_config/hmm
|
|
::utility::mkVar hmm_mode Text user mode true detector true true
|
|
::utility::mkVar _hmm_vert_axis Text user vert_axis true detector false true
|
|
::utility::mkVar _hmm_hor_axis Text user hor_axis true detector false true
|
|
::utility::mkVar _hmm_hor_axis_alias Text user hor_axis_alias true detector false true
|
|
::utility::mkVar _hmm_vert_axis_alias Text user vert_axis_alias true detector false true
|
|
::utility::mkVar _hmm_hor_channel_name Text user hor_channel_name true detector false true
|
|
_hmm_vert_axis y_pixel_offset
|
|
_hmm_vert_axis_alias dvaxis
|
|
_hmm_hor_axis polar_angle
|
|
_hmm_hor_axis_alias dtheta
|
|
_hmm_hor_channel_name horizontal_channel_number
|
|
##############################################
|
|
# Creating the histogram memories in SICS
|
|
##############################################
|
|
|
|
# Make a histogram memory object hmm, allows control of the
|
|
# remote histogram server via http, and acquisition
|
|
# of histogram period data.
|
|
|
|
|
|
##############################################
|
|
# Configuring the histogram server
|
|
##############################################
|
|
|
|
# Procedure to read a single config (or any) file, return content as a string.
|
|
proc returnconfigfile {filename} {
|
|
set ::errorInfo ""
|
|
set fh [open $filename]
|
|
set xml [read $fh]
|
|
close $fh
|
|
return [subst $xml]
|
|
}
|
|
|
|
# Here, define a function to let us read back the value of dictionary items from the hmm
|
|
# such as OAT dimensions.
|
|
proc hmmdictitemval {histomem dictitem} {
|
|
set ::errorInfo ""
|
|
set resp [$histomem configure $dictitem]
|
|
set retn [lindex [split $resp " "] 2]
|
|
return $retn
|
|
}
|
|
|
|
##
|
|
# @brief Use histogram server to control acquisitions
|
|
proc set_termination_conditions {count_method count_size count_stop} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
hmm configure FAT_COUNT_METHOD $count_method
|
|
hmm configure FAT_COUNT_SIZE $count_size
|
|
hmm configure FAT_COUNT_STOP $count_stop
|
|
hmm init
|
|
} errmsg] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
|
|
# Simulated counter. No error rate. Required for technical reasons...
|
|
# The simulated counter is used only to block execution till the bm count is actually reached,
|
|
# for the scan example using hmc and bm objects to control the acquisition duration from SICS.
|
|
MakeCounter blockctr SIM -1.0
|
|
blockctr SetExponent 0
|
|
blockctr SetMode timer
|
|
blockctr SetPreset 0
|
|
|
|
|
|
##############################################
|
|
# Support for using expanded histogram period
|
|
# to create interlaced/overlapped histograms
|
|
##############################################
|
|
|
|
# Define an OAT offset variable to use with both scans:
|
|
# It is possible to effectively offset the histogram filler's
|
|
# OAT table by an arbitrary amount. For overlapped data acquisitions, we can
|
|
# configure an oversized histogram period using the EXPAND_OAT parameters
|
|
# in the FAT. Then at each scan stop, before acqisition commences the offset
|
|
# can be adjusted using the OFFSET_OAT paramters of the FAT. By progressively
|
|
# stepping the OFFSET_OAT, an overlapped image can be built up.
|
|
# The global variable oatoffset is defined for this purpose.
|
|
# During the scan, this variable is incremented and can be passed
|
|
# in to an argument of set_oat_offset to provide progressively
|
|
# increasing offset, producing an overlapped histogram.
|
|
#
|
|
global oatoffset
|
|
#
|
|
#Function to apply OAT offsets to the histogram server.
|
|
proc set_oat_offset {oatoff_x oatoff_y oatoff_t} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
hmm configure FAT_OFFSET_OAT_X $oatoff_x
|
|
hmm configure FAT_OFFSET_OAT_Y $oatoff_y
|
|
hmm configure FAT_OFFSET_OAT_T $oatoff_t
|
|
hmm init
|
|
} errmsg] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
|
|
##############################################
|
|
# Support for data acquisition
|
|
##############################################
|
|
|
|
# A simple procedure to read the histogram data through SICS
|
|
# and dump the data to a numbered file.
|
|
proc savehistodata {histomem filename} {
|
|
set ::errorInfo ""
|
|
set fh [open $filename "w"]
|
|
# To get the whole memory, we don't need to specify the start or end arguments.
|
|
# But we need to specify the bank number, this sets the type of data to be read.
|
|
#
|
|
set histodata [$histomem get [hmmdictitemval $histomem bank]]
|
|
# clientput $histodata value
|
|
puts -nonewline $fh $histodata
|
|
close $fh
|
|
return
|
|
}
|
|
|
|
##############################################
|
|
##############################################
|
|
## Scan Callback Procedures ##
|
|
##############################################
|
|
##############################################
|
|
|
|
|
|
proc init {} {
|
|
}
|
|
proc graphics_hpath_setup {parent} {
|
|
}
|
|
proc commands_hpath_setup {parent} {
|
|
}
|
|
proc instrument_hpath_setup {parent} {
|
|
}
|
|
proc experiment_hpath_setup {parent} {
|
|
}
|
|
|
|
proc set_sobj_attributes {} {
|
|
set ::errorInfo ""
|
|
# SICS commands
|
|
sicslist setatt blockctr privilege internal;
|
|
|
|
# histogram memory macros
|
|
sicslist setatt ::histogram_memory::set_oat_offset privilege internal;
|
|
sicslist setatt ::histogram_memory::scan2_runb privilege internal;
|
|
sicslist setatt ::histogram_memory::scan2_runa privilege internal;
|
|
sicslist setatt ::histogram_memory::returnconfigfile privilege internal;
|
|
sicslist setatt ::histogram_memory::save privilege internal;
|
|
|
|
foreach hm_obj [sicslist type histmem] {
|
|
set_sicsobj_atts $hm_obj detector @none $hm_obj false true;
|
|
sicslist setatt $hm_obj privilege user
|
|
sicslist setatt $hm_obj kind hobj
|
|
sicslist setatt $hm_obj nxsave false
|
|
}
|
|
}
|
|
|
|
|
|
##
|
|
# @brief Returns the histogram memory server clock scale.
|
|
#
|
|
# NOTE: The histmem server doesn't provide the clock scale to SICS\n
|
|
# so we just hardwaire 1000 nanoseconds which is the current (10/01/08)\n
|
|
# value on all the servers.
|
|
proc clock_scale {args} {
|
|
set ::errorInfo ""
|
|
switch $args {
|
|
"" { return 1 }
|
|
"units" { return "microseconds"}
|
|
default {
|
|
todo_msg "Set clock_scale as an integer number of nanoseconds"
|
|
}
|
|
}
|
|
}
|
|
## @brief Calculate axis array from a given list of bin boundaries
|
|
#
|
|
# @param proc_name Fully qualified name of the calling procedure
|
|
# @param scale_factor axis scale factor or @none
|
|
# @param offset axis offset or @none
|
|
# @param boundaries list of bin boundaries or @none
|
|
proc calc_axis {proc_name scale_factor offset boundaries args} {
|
|
set ::errorInfo ""
|
|
variable state
|
|
|
|
set parlist [join $args]
|
|
set opt [lindex $parlist 0]
|
|
set arglist [lrange $parlist 1 end]
|
|
if {$scale_factor == "@none" || $boundaries == "@none"} {
|
|
# Don't calculate axis values, we're just setting or getting the graph_type
|
|
} else {
|
|
set i 0
|
|
${proc_name}_array clear
|
|
if {$state($proc_name,graph_type) == "boundaries"} {
|
|
foreach bb $boundaries {
|
|
set val [expr {$scale_factor*$bb + $offset}]
|
|
lappend values $val
|
|
${proc_name}_array putfloat $i $val
|
|
incr i
|
|
}
|
|
} else {
|
|
foreach b0 [lrange $boundaries 0 end-1] b1 [lrange $boundaries 1 end] {
|
|
set val [expr {$scale_factor*($b1 + $b0)/2.0 + $offset}]
|
|
lappend values $val
|
|
${proc_name}_array putfloat $i $val
|
|
incr i
|
|
}
|
|
}
|
|
}
|
|
switch -- $opt {
|
|
"-arrayname" {
|
|
return "${proc_name}_array"
|
|
}
|
|
"-centres" {
|
|
set state($proc_name,graph_type) "centres"
|
|
}
|
|
"-boundaries" {
|
|
set state($proc_name,graph_type) "boundaries"
|
|
}
|
|
"-graph_type" {
|
|
return $state($proc_name,graph_type)
|
|
}
|
|
default {
|
|
return $values
|
|
}
|
|
}
|
|
}
|
|
|
|
sicsdatafactory new ::histogram_memory::y_bin_array
|
|
##
|
|
# @brief Provides y_bin boundary array for data axes
|
|
proc y_bin {args} {
|
|
set ::errorInfo ""
|
|
set opt [lindex $args 0]
|
|
set arglist [lrange $args 1 end]
|
|
set proc_name [namespace origin [lindex [info level 0] 0]]
|
|
switch -- $opt {
|
|
"-centres" - "-boundaries" - "-graph_type" {
|
|
return [calc_axis $proc_name @none @none @none $opt $arglist]
|
|
}
|
|
"-arrayname" {
|
|
return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get Y_BOUNDARIES] $opt $arglist]
|
|
}
|
|
default {
|
|
return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get Y_BOUNDARIES] $args]
|
|
}
|
|
}
|
|
}
|
|
set script_name ::histogram_memory::y_bin
|
|
publish $script_name user
|
|
sicslist setatt $script_name privilege user
|
|
sicslist setatt $script_name kind script
|
|
sicslist setatt $script_name access read_only
|
|
sicslist setatt $script_name dtype floatvarar
|
|
sicslist setatt $script_name dlen 100
|
|
sicslist setatt $script_name klass detector
|
|
sicslist setatt $script_name control false
|
|
sicslist setatt $script_name data true
|
|
sicslist setatt $script_name nxsave true
|
|
sicslist setatt $script_name mutable false
|
|
sicslist setatt $script_name long_name y_bin
|
|
unset script_name
|
|
|
|
sicsdatafactory new ::histogram_memory::x_bin_array
|
|
##
|
|
# @brief Provides x_bin boundary array for data axes
|
|
proc x_bin {args} {
|
|
set ::errorInfo ""
|
|
set opt [lindex $args 0]
|
|
set arglist [lrange $args 1 end]
|
|
set proc_name [namespace origin [lindex [info level 0] 0]]
|
|
switch -- $opt {
|
|
"-centres" - "-boundaries" - "-graph_type" {
|
|
return [calc_axis $proc_name @none @none @none $opt $arglist]
|
|
}
|
|
"-arrayname" {
|
|
return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get X_BOUNDARIES] $opt $arglist]
|
|
}
|
|
default {
|
|
return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get X_BOUNDARIES] $args]
|
|
}
|
|
}
|
|
}
|
|
set script_name ::histogram_memory::x_bin
|
|
publish $script_name user
|
|
sicslist setatt $script_name privilege user
|
|
sicslist setatt $script_name kind script
|
|
sicslist setatt $script_name access read_only
|
|
sicslist setatt $script_name dtype floatvarar
|
|
sicslist setatt $script_name dlen 100
|
|
sicslist setatt $script_name klass detector
|
|
sicslist setatt $script_name control false
|
|
sicslist setatt $script_name data true
|
|
sicslist setatt $script_name nxsave true
|
|
sicslist setatt $script_name mutable false
|
|
sicslist setatt $script_name long_name x_bin
|
|
unset script_name
|
|
|
|
# requires detector_active_width_mm det_radius_mm
|
|
sicsdatafactory new ::histogram_memory::y_pixel_offset_array
|
|
proc y_pixel_offset {args} {
|
|
set ::errorInfo ""
|
|
variable state
|
|
set opt [lindex $args 0]
|
|
set arglist [lrange $args 1 end]
|
|
set proc_name [namespace origin [lindex [info level 0] 0]]
|
|
switch -- $opt {
|
|
"-centres" - "-boundaries" - "-graph_type" {
|
|
return [calc_axis $proc_name @none @none @none $opt $arglist]
|
|
}
|
|
"-arrayname" {
|
|
set det_height_mm [SplitReply [detector_active_height_mm]]
|
|
set max_b [OAT_TABLE -get Y_MAX]
|
|
set min_b [OAT_TABLE -get Y_MIN]
|
|
set scale_factor [expr {$det_height_mm / ($max_b - $min_b)}]
|
|
set offset 0.0
|
|
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get Y_BOUNDARIES] $opt $arglist]
|
|
}
|
|
"-units" {
|
|
return "mm"
|
|
}
|
|
default {
|
|
set det_height_mm [SplitReply [detector_active_height_mm]]
|
|
set max_b [OAT_TABLE -get Y_MAX]
|
|
set min_b [OAT_TABLE -get Y_MIN]
|
|
set scale_factor [expr {$det_height_mm / ($max_b - $min_b)}]
|
|
set offset 0.0
|
|
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get Y_BOUNDARIES] $args]
|
|
}
|
|
}
|
|
}
|
|
set script_name ::histogram_memory::y_pixel_offset
|
|
publish $script_name user
|
|
sicslist setatt $script_name privilege user
|
|
sicslist setatt $script_name kind script
|
|
sicslist setatt $script_name access read_only
|
|
sicslist setatt $script_name dtype floatvarar
|
|
sicslist setatt $script_name dlen 100
|
|
sicslist setatt $script_name klass detector
|
|
sicslist setatt $script_name control false
|
|
sicslist setatt $script_name data true
|
|
sicslist setatt $script_name nxsave true
|
|
sicslist setatt $script_name mutable false
|
|
sicslist setatt $script_name long_name y_pixel_offset
|
|
sicslist setatt $script_name units [::histogram_memory::y_pixel_offset -units]
|
|
unset script_name
|
|
|
|
# requires detector_active_width_mm det_radius_mm
|
|
sicsdatafactory new ::histogram_memory::x_pixel_offset_array
|
|
proc x_pixel_offset {args} {
|
|
set ::errorInfo ""
|
|
variable state
|
|
set opt [lindex $args 0]
|
|
set arglist [lrange $args 1 end]
|
|
set proc_name [namespace origin [lindex [info level 0] 0]]
|
|
switch -- $opt {
|
|
"-centres" - "-boundaries" - "-graph_type" {
|
|
return [calc_axis $proc_name @none @none @none $opt $args]
|
|
}
|
|
"-arrayname" {
|
|
set det_width_mm [SplitReply [detector_active_width_mm]]
|
|
set max_b [OAT_TABLE -get X_MAX]
|
|
set min_b [OAT_TABLE -get X_MIN]
|
|
set scale_factor [expr {$det_width_mm / ($max_b - $min_b)}]
|
|
set offset 0.0
|
|
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_BOUNDARIES] $opt $arglist]
|
|
}
|
|
"-units" {
|
|
return "mm"
|
|
}
|
|
default {
|
|
set det_width_mm [SplitReply [detector_active_width_mm]]
|
|
set max_b [OAT_TABLE -get X_MAX]
|
|
set min_b [OAT_TABLE -get X_MIN]
|
|
set scale_factor [expr {$det_width_mm / ($max_b - $min_b)}]
|
|
set offset 0.0
|
|
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_BOUNDARIES] $args]
|
|
}
|
|
}
|
|
}
|
|
set script_name ::histogram_memory::x_pixel_offset
|
|
publish $script_name user
|
|
sicslist setatt $script_name privilege user
|
|
sicslist setatt $script_name kind script
|
|
sicslist setatt $script_name access read_only
|
|
sicslist setatt $script_name dtype floatvarar
|
|
sicslist setatt $script_name dlen 100
|
|
sicslist setatt $script_name klass detector
|
|
sicslist setatt $script_name control false
|
|
sicslist setatt $script_name data true
|
|
sicslist setatt $script_name nxsave true
|
|
sicslist setatt $script_name mutable false
|
|
sicslist setatt $script_name long_name x_pixel_offset
|
|
sicslist setatt $script_name units [::histogram_memory::x_pixel_offset -units]
|
|
unset script_name
|
|
|
|
sicsdatafactory new ::histogram_memory::time_channel_array
|
|
proc time_channel {args} {
|
|
set ::errorInfo ""
|
|
variable state
|
|
set opt [lindex $args 0]
|
|
set arglist [lrange $args 1 end]
|
|
set proc_name [namespace origin [lindex [info level 0] 0]]
|
|
switch -- $opt {
|
|
"-centres" - "-boundaries" - "-graph_type" {
|
|
return [calc_axis $proc_name @none @none @none $opt $args]
|
|
}
|
|
"-arrayname" {
|
|
return [calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE -get T_BOUNDARIES] $opt $arglist]
|
|
}
|
|
default {
|
|
return [calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE -get T_BOUNDARIES] $args]
|
|
}
|
|
}
|
|
}
|
|
set script_name ::histogram_memory::time_channel
|
|
publish $script_name user
|
|
sicslist setatt $script_name privilege user
|
|
sicslist setatt $script_name kind script
|
|
sicslist setatt $script_name access read_only
|
|
sicslist setatt $script_name dtype floatvarar
|
|
sicslist setatt $script_name dlen 100
|
|
sicslist setatt $script_name klass detector
|
|
sicslist setatt $script_name control false
|
|
sicslist setatt $script_name data true
|
|
sicslist setatt $script_name nxsave true
|
|
sicslist setatt $script_name mutable false
|
|
sicslist setatt $script_name long_name time_of_flight
|
|
sicslist setatt $script_name units [::histogram_memory::clock_scale units]
|
|
unset script_name
|
|
}
|
|
|
|
##
|
|
# @brief Provides a standard set of subcommands for the histogram server table
|
|
# configuration commands.
|
|
#
|
|
# @param tag Table identifier, one of BAT CAT FAT NAT OAT SAT SRV
|
|
# @param attributes Defines the list of attributes which you will be allowed to set.
|
|
# @param element_list Defines the list of elements which you will be allowed to set.
|
|
# Use "" if your table doesn't contain any elements.
|
|
# @param args This can be empty, or a list of name value pairs for the attributes
|
|
# and elements which you want to set or one of the subcommands listed below.
|
|
# If args is empty this function will simply return an xml fragment for the named table,
|
|
#
|
|
# Subcommands\n
|
|
# -clear clears the table\n
|
|
# -init A list of name value pairs. If you use attribute or element names then
|
|
# the corresponding table entries will be initilised to the given values, any
|
|
# attributes or elements which aren't specified will be cleared. You can also
|
|
# specify extra parameters to store in the table which might be required to
|
|
# specify limits or constants which may be necessary for deriving configuration
|
|
# parameters.\n
|
|
# -get return the value for the named attribute or element\n
|
|
# -attlist list all of the attributes with their values.\n
|
|
# TODO Maintain "proposed" and "current" tables. Provide a setcurrent command which can
|
|
# only be called by the upload_config command to set the proposed tables as current
|
|
# TODO Allow for top level content in tables and attributes in sub-elements
|
|
proc XXX_TABLE {tag attributes element_list args} {
|
|
set ::errorInfo ""
|
|
global hmm_xml
|
|
if {[llength $args] == 1} {
|
|
set arguments [lindex $args 0]
|
|
} else {
|
|
set arguments $args
|
|
}
|
|
set opt [lindex $arguments 0]
|
|
set arglist [lrange $arguments 1 end]
|
|
switch -- $opt {
|
|
"" {
|
|
foreach att $attributes {
|
|
if {$hmm_xml($tag,[string toupper $att]) != ""} {
|
|
append table "$att=\"$hmm_xml($tag,$att)\"\n"
|
|
}
|
|
}
|
|
set content ""
|
|
foreach name $element_list {
|
|
append content "\n<$name>\n$hmm_xml($tag,$name)\n</$name>"
|
|
}
|
|
if {[info exists table]} {
|
|
return "<$tag\n$table>$content\n</$tag>"
|
|
}
|
|
}
|
|
"-clear" {
|
|
foreach att $attributes {
|
|
set hmm_xml($tag,[string toupper $att]) ""
|
|
}
|
|
foreach element $element_list {
|
|
set hmm_xml($tag,[string toupper $element]) ""
|
|
}
|
|
}
|
|
"-init" {
|
|
foreach att $attributes {
|
|
set hmm_xml($tag,[string toupper $att]) ""
|
|
}
|
|
foreach element $element_list {
|
|
set hmm_xml($tag,[string toupper $element]) ""
|
|
}
|
|
foreach {par val} $arglist {
|
|
set hmm_xml($tag,[string toupper $par]) $val
|
|
}
|
|
}
|
|
"-set" {
|
|
foreach {par val} $arglist {
|
|
set hmm_xml($tag,[string toupper $par]) $val
|
|
}
|
|
}
|
|
"-get" {
|
|
set par [string toupper [lindex $arglist 0]]
|
|
if {[info exists hmm_xml($tag,$par)]} {
|
|
return $hmm_xml($tag,$par)
|
|
} else {
|
|
foreach name [array names hmm_xml $tag,* ] {
|
|
lappend valid_params [lindex [split $name ,] 1]
|
|
}
|
|
error_msg "$par should be one of $valid_params"
|
|
}
|
|
}
|
|
"-attlist" {
|
|
# List attributes
|
|
foreach att $attributes {
|
|
if {$hmm_xml($tag,$att) != ""} {
|
|
lappend table $att $hmm_xml($tag,[string toupper $att])
|
|
}
|
|
}
|
|
if {[info exists table]} {
|
|
clientput $table
|
|
}
|
|
}
|
|
default {
|
|
array set param [string toupper $arguments]
|
|
foreach att [string toupper $attributes] {
|
|
if {[info exists param($att)]} {
|
|
if {[info exists hmm_xml($tag,${att}_MIN)]} {
|
|
if {$param($att) <= $hmm_xml($tag,${att}_MIN)} {
|
|
error_msg "$att must be greater than $hmm_xml($tag,${att}_MIN)"
|
|
}
|
|
}
|
|
if {[info exists hmm_xml($tag,${att}_MAX)]} {
|
|
if {$param($att) >= $hmm_xml($tag,${att}_MAX)} {
|
|
error_msg "$att must be less than $hmm_xml($tag,${att}_MAX)"
|
|
}
|
|
}
|
|
set hmm_xml($tag,$att) $param($att)
|
|
}
|
|
}
|
|
foreach element [string toupper $element_list] {
|
|
if {[info exists param($element)]} {
|
|
set hmm_xml($tag,$element) $param($element)
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Base Address Table configuration parameters as maintained by SICS
|
|
#
|
|
# @see XXX_TABLE for subcommands.
|
|
proc BAT_TABLE {args} {
|
|
set ::errorInfo ""
|
|
set attributes {}
|
|
set elements ""
|
|
set tag BAT
|
|
global hmm_xml
|
|
|
|
switch -glob -- [lindex $args 0] {
|
|
"" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
"-*" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
default {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
}
|
|
}
|
|
BAT_TABLE -clear
|
|
|
|
##
|
|
# @brief CAlibration Table configuration parameters as maintained by SICS
|
|
#
|
|
# @see XXX_TABLE for subcommands.
|
|
proc CAT_TABLE {args} {
|
|
set ::errorInfo ""
|
|
set attributes {}
|
|
set elements ""
|
|
set tag CAT
|
|
global hmm_xml
|
|
|
|
switch -glob -- [lindex $args 0] {
|
|
"" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
"-*" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
default {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
}
|
|
}
|
|
CAT_TABLE -clear
|
|
|
|
##
|
|
# @brief Frequency Address Table configuration parameters as maintained by SICS
|
|
#
|
|
# @see XXX_TABLE for subcommands.
|
|
proc FAT_TABLE {args} {
|
|
set ::errorInfo ""
|
|
set attributes {FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE}
|
|
set elements ""
|
|
set tag FAT
|
|
global hmm_xml
|
|
|
|
switch -glob -- [lindex $args 0] {
|
|
"" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
"-*" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
default {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
}
|
|
}
|
|
FAT_TABLE -clear
|
|
|
|
##
|
|
# @brief Offset Address Table configuration parameters as maintained by SICS
|
|
#
|
|
# @param -clear clears OAT_TABLE XML fragment
|
|
# @param -init X_MIN <x0> X_MAX <x1> Y_MIN <y0> Y_MAX <y1>
|
|
# Initialise minimum and maximum bin boundaries.
|
|
# @param -get
|
|
# @param -attlist
|
|
# @param -clear clears the oat table and the fat table SIZE_PERIOD
|
|
#
|
|
# Sets X_BOUNDARIES, Y_BOUNDARIES and T_BOUNDARIES
|
|
# @see XXX_TABLE for subcommands.
|
|
proc OAT_TABLE {args} {
|
|
set ::errorInfo ""
|
|
global hmm_xml
|
|
set attributes {NO_OAT_X_CHANNELS NO_OAT_Y_CHANNELS NO_OAT_T_CHANNELS}
|
|
set tag OAT
|
|
set coord_list {X Y T}
|
|
set elements $coord_list
|
|
|
|
switch -glob -- [lindex $args 0] {
|
|
"" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
"-*" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
"-clear" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
FAT_TABLE SIZE_PERIOD ""
|
|
}
|
|
default {
|
|
array set param $args
|
|
foreach coord $coord_list {
|
|
if {[info exists param($coord)] == 0} {
|
|
error_msg "You must specify $coord_list"
|
|
}
|
|
}
|
|
set NOXCH [SplitReply [hmm configure dim0]]
|
|
set NOYCH [SplitReply [hmm configure dim1]]
|
|
set NOTCH [SplitReply [hmm configure dim2]]
|
|
foreach coord $coord_list {
|
|
if {[info exists param($coord)]} {
|
|
set bbnum [llength $param($coord)]
|
|
set hmm_xml(OAT,${coord}_BOUNDARIES) ""
|
|
if {$bbnum > 2} {
|
|
set NO${coord}CH [expr {$bbnum - 1}]
|
|
if {[info exists param(N${coord}C)]} {
|
|
set NO${coord}CH $param(N${coord}C)
|
|
}
|
|
set hmm_xml(OAT,${coord}_BOUNDARIES) [lrange $param($coord) 0 [set NO${coord}CH]]
|
|
set hmm_xml(OAT,$coord) ${coord}_BOUNDARIES
|
|
} elseif {$bbnum == 2} {
|
|
set hmm_xml(OAT,$coord) $param($coord)
|
|
set b0 [lindex $param($coord) 0]
|
|
set bstep [expr {[lindex $param($coord) 1] - $b0}]
|
|
if {$bstep == 0} {
|
|
return -code error "The generating bin boundaries for $coord are equal"
|
|
}
|
|
if {[info exists param(N${coord}C)]} {
|
|
set NO${coord}CH $param(N${coord}C)
|
|
for {set bb $b0; set i 0} {$i <= [set NO${coord}CH]} {incr i; set bb [expr {$bb + $bstep}] } {
|
|
lappend hmm_xml(OAT,${coord}_BOUNDARIES) $bb
|
|
}
|
|
} else {
|
|
if {$bstep > 0} {
|
|
set bfinal [set hmm_xml(OAT,${coord}_MAX)]
|
|
} else {
|
|
set bfinal [set hmm_xml(OAT,${coord}_MIN)]
|
|
}
|
|
set brange [expr {abs($bfinal - $b0)}]
|
|
set NO${coord}CH [expr {int(floor(abs($brange/$bstep)))}]
|
|
for {set bb $b0} {1} {set bb [expr {$bb + $bstep}] } {
|
|
lappend hmm_xml(OAT,${coord}_BOUNDARIES) $bb
|
|
if [expr {abs($bfinal - $bb) < abs($bstep)}] { break }
|
|
}
|
|
}
|
|
} else {
|
|
error_msg "You must specify at least two bin boundaries for $coord"
|
|
}
|
|
}
|
|
}
|
|
set arglist [list NO_OAT_X_CHANNELS $NOXCH NO_OAT_Y_CHANNELS $NOYCH NO_OAT_T_CHANNELS $NOTCH]
|
|
XXX_TABLE $tag $attributes $elements $arglist
|
|
FAT_TABLE SIZE_PERIOD [expr {$NOXCH*$NOYCH*$NOTCH}]
|
|
return [XXX_TABLE $tag $attributes $elements]
|
|
}
|
|
}
|
|
}
|
|
OAT_TABLE -clear
|
|
|
|
##
|
|
# @brief Spatial Allocation Table configuration parameters as maintained by SICS
|
|
#
|
|
# @see XXX_TABLE for subcommands.
|
|
proc SAT_TABLE {args} {
|
|
set ::errorInfo ""
|
|
set attributes {}
|
|
set elements ""
|
|
set tag SAT
|
|
global hmm_xml
|
|
|
|
switch -glob -- [lindex $args 0] {
|
|
"" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
"-*" {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
default {
|
|
XXX_TABLE $tag $attributes $elements $args
|
|
}
|
|
}
|
|
}
|
|
SAT_TABLE -clear
|
|
|
|
proc ::histogram_memory::clear_tables {} {
|
|
set ::errorInfo ""
|
|
BAT_TABLE -clear
|
|
CAT_TABLE -clear
|
|
FAT_TABLE -clear
|
|
OAT_TABLE -clear
|
|
SAT_TABLE -clear
|
|
}
|
|
|
|
##
|
|
# @brief When called without arguments this returns the name of the filler defaults file
|
|
# for the histogram server. When called with an argument it sets the current name of the
|
|
# filler defaults file.
|
|
#
|
|
# When anstohm_linked.xml is uploaded to the histogram server it calls this via
|
|
# command substitution to set the name of the filler defaults file.
|
|
proc ::histogram_memory::filler_defaults {args} {
|
|
set ::errorInfo ""
|
|
variable hmm_def_filename
|
|
if {[llength $args] == 0} {
|
|
return $hmm_def_filename
|
|
} else {
|
|
set hmm_def_filename $args
|
|
}
|
|
}
|
|
|
|
# XXX DEPRECATED, use upload_config instead.
|
|
proc ::histogram_memory::configure_server {instdef} {
|
|
clientput "WARNING: ::histogram_memory::configure_server is deprecated, call ::histogram_memory::upload_config instead"
|
|
::histogram_memory::upload_config $instdef
|
|
}
|
|
# TODO Set current oat table after uploading proposed oat_table
|
|
proc ::histogram_memory::upload_config {filler_defaults} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
::histogram_memory::filler_defaults $filler_defaults
|
|
hmm stop
|
|
hmm configure init 1
|
|
hmm init
|
|
# Restore the init level to 0
|
|
# subesquent inits will only upload specified FAT settings to histogram server.
|
|
hmm configure init 0
|
|
|
|
# Now issue stop to the server.
|
|
# This not only makes sure it's stopped, but lets us see certain configuration variables
|
|
# which get placed in the dictionary as part of the status checking done during the stop.
|
|
hmm configure statuscheck true
|
|
hmm stop
|
|
hmm configure statuscheck false
|
|
::histogram_memory::configure_dims
|
|
} errmsg] {
|
|
hmm configure init 0
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
clientput "histmem configuration uploaded"
|
|
}
|
|
|
|
|
|
##
|
|
# @brief Configure the dimensions for the controlling histogram object, and for
|
|
# each auxiliary histogram object.
|
|
proc ::histogram_memory::configure_dims {} {
|
|
set ::errorInfo ""
|
|
if {[instname] == "wombat"} {
|
|
array set dim_map {
|
|
hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc} {hmm_dim2 stitch_nxc}}
|
|
hmm,fat_read_data_type HISTOPERIOD_XYT
|
|
hmm_xy {{hmm_dim0 stitch_nyc} {hmm_dim1 stitch_nxc}}
|
|
hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY
|
|
hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nxc}}
|
|
hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT
|
|
hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc}}
|
|
hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT
|
|
hmm_x {{hmm_dim0 stitch_nxc}}
|
|
hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X
|
|
hmm_y {{hmm_dim0 stitch_nyc}}
|
|
hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y
|
|
hmm_t {{hmm_dim0 oat_ntc_eff}}
|
|
hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T
|
|
}
|
|
} else {
|
|
array set dim_map {
|
|
hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff} {hmm_dim2 oat_nxc_eff}}
|
|
hmm,fat_read_data_type HISTOPERIOD_XYT
|
|
hmm_xy {{hmm_dim0 oat_nyc_eff} {hmm_dim1 oat_nxc_eff}}
|
|
hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY
|
|
hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nxc_eff}}
|
|
hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT
|
|
hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff}}
|
|
hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT
|
|
hmm_x {{hmm_dim0 oat_nxc_eff}}
|
|
hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X
|
|
hmm_y {{hmm_dim0 oat_nyc_eff}}
|
|
hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y
|
|
hmm_t {{hmm_dim0 oat_ntc_eff}}
|
|
hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T
|
|
}
|
|
}
|
|
|
|
foreach hm_obj [sicslist type histmem] {
|
|
set rank [SplitReply [$hm_obj configure rank]]
|
|
set hmm_length 1
|
|
foreach elmt $dim_map($hm_obj) {
|
|
set [lindex $elmt 0] [hmmdictitemval hmm [lindex $elmt 1]]
|
|
}
|
|
$hm_obj configure FAT_READ_DATA_TYPE $dim_map($hm_obj,fat_read_data_type)
|
|
$hm_obj stop
|
|
$hm_obj configure init 0
|
|
$hm_obj init
|
|
|
|
for {set i 0} {$i < $rank} {incr i} {
|
|
set hmm_length [expr {$hmm_length * [set hmm_dim$i]} ]
|
|
$hm_obj configure dim$i [set hmm_dim$i]
|
|
}
|
|
}
|
|
}
|
|
##
|
|
# @brief If set to true then the frame_source will always be set to INTERNAL.
|
|
#
|
|
# @see ::histogram_memory::set_frame_source
|
|
proc ::histogram_memory::frame_source_always_internal {args} {
|
|
set ::errorInfo ""
|
|
variable fs_always_internal
|
|
if {$args == ""} {
|
|
return $fs_always_internal
|
|
}
|
|
set flag [lindex $args 0]
|
|
if {[string is boolean $flag] == 0} {
|
|
return -code error "$args must be a boolean"
|
|
} else {
|
|
set fs_always_internal $flag
|
|
}
|
|
}
|
|
publish ::histogram_memory::frame_source_always_internal mugger
|
|
##
|
|
# @brief Return the last frame source which SICS attempted to set
|
|
proc ::histogram_memory::get_frame_source {} {
|
|
set ::errorInfo ""
|
|
if [::histogram_memory::frame_source_always_internal] {
|
|
clientput "WARNING: The frame source is set to always_internal" value
|
|
clientput "Use ::histogram_memory::frame_source_always_internal <true/false> to change this." value
|
|
return INTERNAL
|
|
} else {
|
|
return [SplitReply [hmm configure fat_frame_source]]
|
|
}
|
|
}
|
|
##
|
|
# @brief Sets the histogram memory frame source to the given value.
|
|
#
|
|
# @param srce EXTERNAL or INTERNAL
|
|
# @param always_internal true or false (optional) (default false)
|
|
proc ::histogram_memory::set_frame_source {srce} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
if [::histogram_memory::frame_source_always_internal] {
|
|
clientput "WARNING: The frame source is set to always_internal" value
|
|
clientput "Use ::histogram_memory::frame_source_always_internal <true/false> to change this." value
|
|
hmm configure fat_frame_source INTERNAL
|
|
} else {
|
|
hmm configure fat_frame_source $srce
|
|
}
|
|
::histogram_memory::stop
|
|
hmm init
|
|
} errmsg ] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
##
|
|
# @brief Return the last frame frequency which SICS attempted to set
|
|
proc ::histogram_memory::get_frame_freq {} {
|
|
return [SplitReply [hmm configure fat_frame_frequency]]
|
|
}
|
|
|
|
##
|
|
# @brief Sets the histogram memory frame frequency to the given value.
|
|
#
|
|
# @param freq Frequency in Hz.\n
|
|
# @param frame_source INTERNAL or EXTERNAL(default)
|
|
#
|
|
# If freq=0 then it sets the frequency to 50Hz with an internal frame source. This is useful
|
|
# if you are setting the frequency from a chopper which is stopped.
|
|
proc ::histogram_memory::set_frame_freq {freq {frame_source EXTERNAL}} {
|
|
set ::errorInfo ""
|
|
variable state
|
|
|
|
if {[string is double $freq] == 0 || $freq < 0} {
|
|
return -code error "Frequency must be a non-negative floating point number"
|
|
}
|
|
|
|
if [ catch {
|
|
# Frame source for each instrument if freq = 0, this can happen when automatically
|
|
# setting frequencies from choppers.
|
|
array set frame_source_on_zero_freq {
|
|
echidna INTERNAL
|
|
koala INTERNAL
|
|
kowari EXTERNAL
|
|
pelican INTERNAL
|
|
platypus EXTERNAL
|
|
quokka INTERNAL
|
|
taipan INTERNAL
|
|
wombat INTERNAL
|
|
}
|
|
#TODO Add tolerance parameters to choppercontroller
|
|
if {abs($freq - 0) <= [expr {2.0/60.0}]} {
|
|
set zf_frame_source $frame_source_on_zero_freq([instname])
|
|
if {$zf_frame_source == "INTERNAL"} {
|
|
clientput "WARNING: A histmem frame frequency of zero was requested, setting frequency to 50Hz instead" value
|
|
} else {
|
|
clientput "WARNING: A histmem frame frequency of zero was requested, setting frequency to 50Hz instead" value
|
|
clientput "WARNING: You must provide an external oscillator" value
|
|
}
|
|
::histogram_memory::set_frame_source $zf_frame_source
|
|
set newfreq 50
|
|
} else {
|
|
::histogram_memory::set_frame_source [string toupper $frame_source]
|
|
::set newfreq $freq
|
|
}
|
|
::histogram_memory::stop
|
|
set clock_scale_ns 1000.0
|
|
OAT_TABLE -set T_MAX [expr {1.0e9/($newfreq*$clock_scale_ns)}]
|
|
hmm configure fat_frame_frequency $newfreq
|
|
hmm init
|
|
} errmsg] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
publish ::histogram_memory::set_frame_freq user
|
|
|
|
proc ::histogram_memory::t_max {} {
|
|
set frame_freq [SplitReply [hmm configure fat_frame_frequency]]
|
|
}
|
|
##
|
|
# @brief Sets histogram server to default configuration, initialises SICS histogram memory
|
|
# dictionary values and clears SICS OAT BAT CAT FAT ... tables
|
|
proc ::histogram_memory::_initialize {} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
set configuration "::histogram_memory::returnconfigfile config/hmm/anstohm_linked.xml"
|
|
::histogram_memory::y_bin -boundaries
|
|
::histogram_memory::x_bin -boundaries
|
|
::histogram_memory::y_pixel_offset -boundaries
|
|
::histogram_memory::x_pixel_offset -boundaries
|
|
::histogram_memory::time_channel -boundaries
|
|
::histogram_memory::clear_tables
|
|
#XXX ::histogram_memory::upload_config Filler_defaults
|
|
|
|
foreach hm_obj [sicslist type histmem] {
|
|
$hm_obj configure hmaddress http://das1-[instname].nbi.ansto.gov.au:8080
|
|
$hm_obj configure username spy
|
|
$hm_obj configure password 007
|
|
$hm_obj configure histmode transparent
|
|
}
|
|
hmm configure init 0
|
|
hmm init
|
|
hmm configure statuscheck true
|
|
hmm stop
|
|
hmm configure statuscheck false
|
|
OAT_TABLE -init
|
|
OAT_TABLE -set T_MIN 0
|
|
::histogram_memory::frame_source_always_internal false
|
|
::histogram_memory::set_frame_freq 50
|
|
::histogram_memory::count_method unlimited
|
|
::histogram_memory::count_size 0
|
|
FAT_TABLE -init SIZE_PERIOD_MAX 125000000
|
|
hmm configure hmDataPath ../HMData
|
|
hmm configure hmconfigscript $configuration
|
|
::histogram_memory::configure_dims
|
|
} ] {
|
|
clientput $::errorInfo
|
|
}
|
|
}
|
|
|
|
Publish ::histogram_memory::set_oat_offset user
|
|
Publish ::histogram_memory::scan2_runb user
|
|
Publish ::histogram_memory::scan2_runa user
|
|
Publish ::histogram_memory::returnconfigfile user
|
|
Publish ::histogram_memory::save user
|
|
Publish BAT_TABLE user
|
|
Publish CAT_TABLE user
|
|
Publish FAT_TABLE user
|
|
Publish OAT_TABLE user
|
|
Publish SAT_TABLE user
|
|
|
|
proc ::histogram_memory::pre_count {} {}
|
|
proc ::histogram_memory::post_count {} {}
|
|
|
|
##
|
|
# @brief Start an acquisition, non-blocking by default
|
|
#
|
|
# @param block (optional) default="noblock"
|
|
proc ::histogram_memory::start {{blocking "noblock"}} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
set options [list block noblock]
|
|
if {[lsearch $options $blocking] == -1} {
|
|
return -code error "Valid options are $options"
|
|
}
|
|
::histogram_memory::pre_count
|
|
hmm init
|
|
hmc start 1000000000 timer pause 1
|
|
set reply [SplitReply [hmm configure daq]]
|
|
if {$reply != "Started"} {
|
|
return -code error "Histogram server failed to start"
|
|
}
|
|
clientput "histmem started" value
|
|
if {$blocking == "block"} {
|
|
blockctr count 0
|
|
::histogram_memory::pause
|
|
}
|
|
} errmsg] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief This sends the magic incantation which stops the histogram server.
|
|
proc ::histogram_memory::stop {} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
hmm pause
|
|
hmm configure statuscheck true
|
|
hmm stop
|
|
hmm configure statuscheck false
|
|
set reply [SplitReply [hmm configure daq]]
|
|
if {$reply != "Stopped"} {
|
|
return -code error "Histogram server failed to stop"
|
|
}
|
|
clientput "histmem stopped" value
|
|
} errmsg ] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
##
|
|
# @brief Allows resume if MULTIPLE_DATASETS=DISABLE, otherwise if MULTIPLE_DATASETS=ENABLE
|
|
# (the default) this acts like a stop but allows a fast restart.
|
|
proc ::histogram_memory::pause {} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
hmm pause
|
|
::histogram_memory::post_count
|
|
set reply [SplitReply [hmm configure daq]]
|
|
if {$reply != "Paused"} {
|
|
return -code error "Histogram server failed to pause"
|
|
}
|
|
clientput "histmem paused" value
|
|
} errmsg ] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Choose method for controlling acquisition duration.
|
|
#
|
|
# @param method Set histmem mode or return current mode if blank
|
|
proc ::histogram_memory::count_method {{method ""}} {
|
|
set ::errorInfo ""
|
|
set modes [list time monitor unlimited period count frame]
|
|
if {$method==""} {
|
|
return [SplitReply [hmm_mode]]
|
|
} else {
|
|
if {[lsearch $modes $method] == -1} {
|
|
return -code error "Count mode, $method, must be one of $modes"
|
|
}
|
|
if [ catch {
|
|
hmm configure FAT_COUNT_METHOD $method
|
|
hmm init
|
|
hmm_mode $method
|
|
} errmsg] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Count until the preset count size has been reached.
|
|
#
|
|
# @param preset: The interpretation of the preset depends on the count method.
|
|
# @see count_method
|
|
proc ::histogram_memory::count_size {{preset ""}} {
|
|
set ::errorInfo ""
|
|
variable state
|
|
|
|
if {$preset == ""} {
|
|
return $state(preset)
|
|
} else {
|
|
if {[string is double $preset] == 0 || $preset < 0} {
|
|
return -code error "The preset must be a non-negative floating point number"
|
|
}
|
|
if [ catch {
|
|
hmm configure FAT_COUNT_SIZE [expr {100.0 * $preset}]
|
|
hmm init
|
|
set state(preset) $preset
|
|
} errmsg] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Check histogram memory status
|
|
#
|
|
# @return Stopped, Paused, Started, or raises a Tcl error
|
|
proc ::histogram_memory::status {} {
|
|
set ::errorInfo ""
|
|
if [ catch {
|
|
set reply [SplitReply [hmm configure daq]]
|
|
} errmsg ] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
} else {
|
|
return $reply
|
|
}
|
|
}
|
|
|
|
##
|
|
# @brief Set stop condition for histogram memory
|
|
#
|
|
# @param condition
|
|
proc ::histogram_memory::stop_condition {condition} {
|
|
set ::errorInfo ""
|
|
variable state
|
|
array set count_stop {immediate IMMEDIATE period AT_END_OF_PERIOD}
|
|
if {$condition == ""} {
|
|
return $state(stop_cond)
|
|
} else {
|
|
if [ catch {
|
|
hmm configure FAT_COUNT_STOP $count_stop($condition)
|
|
hmm init
|
|
set state(stop_cond) $condition
|
|
} errmsg] {
|
|
return -code error "$errmsg\n$::errorInfo"
|
|
}
|
|
}
|
|
}
|
|
namespace eval ::histogram_memory {
|
|
#TODO Create GumTree commands to setup, start and stop the histmem
|
|
##
|
|
# @brief Choose method for controlling acquisition duration.
|
|
#command mode {text:time,monitor,unlimited,period,count,frame method} {}
|
|
##
|
|
# @brief Count until the preset count size has been reached.
|
|
#
|
|
# @param preset: The interpretation of the preset depends on the count method.
|
|
# @see count_method
|
|
#command preset {float: pre} {}
|
|
##
|
|
# @brief Set stop condition for histogram memory
|
|
#
|
|
# @param condition
|
|
#command stop_condition {text:immediate,period condition}
|
|
}
|
|
|
|
##
|
|
# @brief Convenience command providing user interface to histogram control
|
|
#
|
|
# @param cmd is one of start, stop, pause, mode, preset, fsrce, status, loadconf
|
|
# @param args is an optional list of arguments for the given command
|
|
proc _histmem {cmd args} {
|
|
set ::errorInfo ""
|
|
set reply ""
|
|
if [ catch {
|
|
switch $cmd {
|
|
"start" {
|
|
eval "::histogram_memory::start $args"
|
|
}
|
|
"stop" {
|
|
::histogram_memory::stop
|
|
}
|
|
"pause" {
|
|
::histogram_memory::pause
|
|
}
|
|
"mode" {
|
|
if {$args == ""} {
|
|
set reply [::histogram_memory::count_method ]
|
|
} else {
|
|
eval "::histogram_memory::count_method $args"
|
|
}
|
|
}
|
|
"preset" {
|
|
if {$args == ""} {
|
|
set reply [::histogram_memory::count_size ]
|
|
} else {
|
|
eval "::histogram_memory::count_size $args"
|
|
}
|
|
}
|
|
"freq" {
|
|
if {$args == ""} {
|
|
set reply [::histogram_memory::get_frame_freq ]
|
|
} else {
|
|
eval "::histogram_memory::set_frame_freq $args"
|
|
}
|
|
}
|
|
"fsrce" {
|
|
if {$args == ""} {
|
|
set reply [::histogram_memory::get_frame_source ]
|
|
} else {
|
|
eval "::histogram_memory::set_frame_source $args"
|
|
}
|
|
}
|
|
"status" {
|
|
set reply [::histogram_memory::status]
|
|
}
|
|
"loadconf" {
|
|
# Loads configuration tables (OAT, FAT, ...) to histogram server
|
|
if {$args == ""} {
|
|
::histogram_memory::upload_config Filler_defaults
|
|
} else {
|
|
eval "::histogram_memory::upload_config $args"
|
|
}
|
|
}
|
|
default {
|
|
return -code error "Available commands are, start stop pause mode preset freq fsrce status loadconf"
|
|
}
|
|
}
|
|
} errmsg ] {
|
|
return -code error $errmsg
|
|
}
|
|
if {$reply != ""} {
|
|
clientput $reply value
|
|
}
|
|
}
|