Files
sics/site_ansto/instrument/config/scan/scan_common_1.tcl
2014-05-16 17:23:58 +10:00

750 lines
24 KiB
Tcl

##
# @file Scan functionality and common high level commands are defined here.
#
# namespace variables\n
# ::scan::save_filetype data/scratch, controls if data will be saved to a
# scratch file.\n
# ::scan::reset_position true/false (default=true), drive motor back to start
# position at end of scan\n
# ::scan::force_scan true/false, (default=false), Will force a scan if the
# instrument isn't ready, eg shutters closed. Note: The scan will still fail if
# you are scanning against a motor and motion control is disabled.\n
# If force_scan is true it is immediately reset to false after it is checked.
#TODO Get rid of duplication in bmonscan and hmscan code
namespace eval scan {
variable ic_runscanpar
variable ic_hmm_datatype
variable save_filetype
variable reset_position
variable check_thread0
variable check_instrument_ready
variable force_scan
variable scanvarlist
variable startlist
variable steplist
variable scaninitposlist
set check_thread0 true
set check_instrument_ready true
set force_scan false
set save_filetype "data"
set reset_position "false"
if {[SplitReply [motor_simulation]] == "true"} {
set check_thread0 false
}
}
##
# @brief This is a convenience command which allows hmscans to be forced.
# Call this before calling hmscan run to force a scan if the instrument isn't ready.
proc force_scan {} {
set ::scan::force_scan "true"
}
publish force_scan user
proc ::scan::print_hdr_svars {sobj point counts actime} {
set numvars [SplitReply [$sobj noscanvar]]
set infostart [expr [string length $sobj] + 1]
for {set i 0} {$i < $numvars} {incr i} {
set svinfo [$sobj getvarpar $i]
foreach {svar start step} [ split [string range $svinfo $infostart end] = ] {
set svar [string trim $svar]
lappend scanvarlist $svar
lappend scanstartlist $start
lappend scansteplist $step
lappend varposlist [SplitReply [$svar]]
}
}
set fmtstr "%-4.4s [string repeat "%-9.9s " $numvars] %-14s %-7.7s"
set headercmd [subst {format "$fmtstr" NP $scanvarlist Counts Time}]
set header [eval $headercmd ]
set fmtstr "%-4d [string repeat "%-9.3f " $numvars] %-14d %-7.2f"
set datacmd [subst {format "$fmtstr" $point $varposlist $counts $actime} ]
set data [eval $datacmd]
clientput $header
clientput $data
}
proc ::scan::bm_scan_collect {sobj uobj point} {
set counts [SplitReply [bm getcounts]]
set actime [SplitReply [bm gettime]]
print_hdr_svars $sobj $point $counts $actime
for {set chn 0} {$chn < $::counter::isc_numchannels} {incr chn} {
clientput "Channel $chn [SplitReply [bm getmonitor $chn]]"
}
}
proc ::scan::hmm_scan_collect {sobj uobj point} {
set counts [SplitReply [::histogram_memory::total_counts]]
set actime [SplitReply [::histogram_memory::time]]
print_hdr_svars $sobj $point $counts $actime
for {set bmn 1} {$bmn <= $::counter::isc_numchannels} {incr bmn} {
set bmon bm$bmn
clientput "Monitor $bmn [SplitReply [$bmon getcounts]]"
}
}
proc ::scan::hmscanend_event {} {
variable scanvarlist
variable startlist
variable steplist
::scan::runscan_cmd -set feedback status IDLE
}
publish ::scan::hmscanend_event user
proc ::scan::bmonscanend_event {} {
variable scanvarlist
variable startlist
variable steplist
::scan::hdb_bmonscan -set feedback status IDLE
}
publish ::scan::bmonscanend_event user
proc ::scan::ic_initialize {} {
if [ catch {
variable ic_runscanpar
variable ic_hmm_datatype
set ic_hmm_datatype HISTOGRAM_XYT
MakeScanCommand hmscan bm $::cfPath(scan)/scan_common_1.hdd recover.bin
MakeScanCommand bmonscan bm $::cfPath(scan)/scan_common_1.hdd recover.bin
bmonscan configure script
bmonscan function writeheader ::scan::donothing
bmonscan function writepoint ::scan::bm_writepoint
bmonscan function count ::scan::bm_count
bmonscan function collect ::scan::bm_scan_collect
bmonscan function prepare ::scan::bm_scan_prepare
bmonscan function finish ::scan::bm_scan_finish
hmscan configure script
hmscan function writeheader ::scan::donothing
hmscan function writepoint ::scan::hmm_writepoint
hmscan function count ::scan::hmm_count
hmscan function collect ::scan::hmm_scan_collect
hmscan function prepare ::scan::hmm_scan_prepare
hmscan function finish ::scan::hmm_scan_finish
# TODO Use ic_runscanpar to create the ::scan::runscan command and
# to validate the "runscan" proc parameters.
array set ic_runscanpar [subst {
scanvar text=drivable
start float
stop float
numpoints int=0,inf
mode text=[join [concat [list time unlimited period count frame] $::counter::isc_beam_monitor_list ] , ]
preset float=0,inf
datatype text=[join [array names ::nexus::histmem_filetype_spec] , ]
savetype text=save,nosave
force boolean
}]
scriptcallback connect hmscan SCANEND ::scan::hmscanend_event
scriptcallback connect bmonscan SCANEND ::scan::bmonscanend_event
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Returns an error if a scan variable target position exceeds the limits.
proc ::scan::check_limit {scan_variable limit_name target} {
switch $limit_name {
"hardlowerlim" - "softlowerlim" {
set limit [SplitReply [$scan_variable $limit_name]]
if { $target < $limit} {
return -code error "Final position of $target violates $limit_name $limit for $scan_variable"
}
}
"hardupperlim" - "softupperlim" {
set limit [SplitReply [$scan_variable $limit_name]]
if { $target > $limit} {
return -code error "Final position of $target violates $limit_name $limit for $scan_variable"
}
}
default {
return -code error "Invalid limit name $limit_name"
}
}
}
## \brief check final position against scan variable limits
#
# NOTE: The sics scan object alread checks if a variable is drivable
# so we don't have to.
# TODO We can't check limits of virtual motors yet because the
# configurablevirtualmotor doesn't set a checklimits function.
proc ::scan::check_scanvar {sobj uobj} {
variable check_thread0
set vlist [split [$sobj getvarpar 0] = ];
set NP [SplitReply [$sobj np]]
set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]]
set scan_start [lindex $vlist 1];
set scan_increment [lindex $vlist 2];
if {[getatt $scan_variable type] == "motor"} {
if {[SplitReply [$scan_variable fixed]] >= 0} {
return -code error "ERROR: Can't drive scan variable, $scan_variable position is set to 'fixed'"
} else {
set mtype [getatt $scan_variable mtype]
if {$mtype != "tclmot" && $check_thread0 && [SplitReply [$scan_variable thread0]] == -1} {
return -code error "ERROR: Can't scan ${scan_variable}. Thread zero has stopped running on the motion controller"
}
}
set scan_final [expr $scan_start + ($NP-1) * $scan_increment]
if [catch {
::scan::check_limit $scan_variable softlowerlim $scan_final
::scan::check_limit $scan_variable softupperlim $scan_final
::scan::check_limit $scan_variable softlowerlim $scan_start
::scan::check_limit $scan_variable softupperlim $scan_start
}] {
return -code error $::errorInfo
}
}
}
##
# @brief Instrument specific scan configurations can override this procedure to perform some setup
# before running a scan, eg setting hmm frame frequency.
#
# NOTES\n
# Returning an error will cause the scan to abort before it starts\n
# eg\n
# return -code error "error message"
proc ::scan::pre_hmm_scan_prepare {} {}
##
# @brief Do some pre-scan checks and prime the DAE
proc ::scan::hmm_scan_prepare {sobj uobj} {
variable save_filetype
variable ic_hmm_datatype
variable check_instrument_ready
variable force_scan
if {$force_scan || $check_instrument_ready && [::plc::inst_ready]} {
set force_scan false
if [catch {
::scan::check_scanvar $sobj $uobj
::scan::pre_hmm_scan_prepare
}] {
return -code error "HMSCAN ABORTED: $::errorInfo"
}
if [catch {
set numpoints [SplitReply [$sobj np]]
set numvars [SplitReply [$sobj noscanvar]]
set infostart [expr [string length $sobj] + 1]
for {set i 0} {$i < $numvars} {incr i} {
set svinfo [$sobj getvarpar $i]
foreach {sv start step} [ split [string range $svinfo $infostart end] = ] {
lappend scanvarlist $sv
lappend scanstartlist $start
lappend scansteplist $step
}
}
::scan::runscan_cmd -set feedback status BUSY
run_mode "hmscan"
set ::histogram_memory::histmem_axes(SVAR) [SplitReply [sicslist [lindex $::scan::scanvarlist 0] hdb_path] ]
::nexus::newfile $ic_hmm_datatype $save_filetype
foreach sv $scanvarlist scanstart $scanstartlist scanstep $scansteplist {
clientput "Scanvar: $sv start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
}
clientput "Datatype: $ic_hmm_datatype"
# Prime DAE
hmm pause
}] {
run_mode "normal"
return -code error $::errorInfo
}
} else {
return -code error "HMSCAN ABORTED: Instrument not ready"
}
}
proc ::scan::hmm_count {sobj uobj point mode preset} {
::scan::runscan_cmd -set feedback scanpoint $point
::scan::runscan_cmd -set feedback scan_variable_value [SplitReply [[lindex $::scan::scanvarlist 0]]]
# Start histogram and block until count is complete
::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
variable scanvarlist
variable startlist
variable steplist
variable scaninitposlist
set $save_filetype "data"
::histogram_memory::stop
::scan::runscan_cmd -set feedback status IDLE
run_mode "normal"
set ::histogram_memory::histmem_axes(SVAR) "/instrument/run_number"
# Make sure that the next save command doesn't overwrite our scan data.
# and clear any data links
::nexus::newfile clear data
if {$reset_position == "true"} {
# set reset_position "false"
foreach svar $scanvarlist initpos $scaninitposlist {
set svtype [getatt $svar type]
if {$svtype == "motor" || $svtype == "configurablevirtualmotor"} {
lappend drivelist $svar $initpos
}
eval drive $drivelist
}
}
# ::histogram_memory::configure_server Filler_defaults
}
proc ::scan::bm_scan_finish {sobj uobj} {
variable reset_position
variable scanvarlist
variable startlist
variable steplist
variable scaninitposlist
::scan::hdb_bmonscan -set feedback status IDLE
run_mode "normal"
set ::histogram_memory::histmem_axes(SVAR) "/instrument/run_number"
# Make sure that the next save command doesn't overwrite our scan data.
# and clear any data links
::nexus::newfile clear data
if {$reset_position == "true"} {
# set reset_position "false"
foreach svar $scanvarlist initpos $scaninitposlist {
set svtype [getatt $svar type]
if {$svtype == "motor" || $svtype == "configurablevirtualmotor"} {
lappend drivelist $svar $initpos
}
eval drive $drivelist
}
}
}
proc ::scan::bm_writepoint {sobj uobj pt} {
::nexus::save $pt
::scan::hdb_bmonscan -set feedback counts [SplitReply [bm getcounts]];
}
#TODO Feedback for Histogram memory scan
proc ::scan::hmm_writepoint {sobj uobj pt} {
variable save_filetype
# Write hdb tree
::nexus::save $pt
}
proc ::scan::donothing {args} {}
proc ::scan::bm_count {sobj uobj point mode preset} {
::scan::hdb_bmonscan -set mode $mode
::scan::hdb_bmonscan -set preset $preset
::scan::hdb_bmonscan -set feedback scanpoint $point;
::scan::hdb_bmonscan -set feedback mode $mode;
::scan::hdb_bmonscan -set feedback preset $preset;
::scan::hdb_bmonscan -set feedback scan_variable_value [SplitReply [[lindex $::scan::scanvarlist 0]]]
::monitor::count $mode $preset
}
proc ::scan::bm_scan_prepare {sobj uobj} {
variable save_filetype
variable check_instrument_ready
variable force_scan
if {$force_scan || $check_instrument_ready && [::plc::inst_ready]} {
set force_scan false
if [catch {
::scan::check_scanvar $sobj $uobj
::scan::pre_hmm_scan_prepare
}] {
return -code error "BMONSCAN ABORTED: $::errorInfo"
}
if [catch {
#TODO Parameterise varindex in some way
set varindex 0
set numpoints [SplitReply [$sobj np]]
set numvars [SplitReply [$sobj noscanvar]]
set infostart [expr [string length $sobj] + 1]
for {set i 0} {$i < $numvars} {incr i} {
set svinfo [$sobj getvarpar $i]
foreach {sv start step} [ split [string range $svinfo $infostart end] = ] {
lappend scanvarlist $sv
lappend scanstartlist $start
lappend scansteplist $step
}
}
set vlist [split [$sobj getvarpar $varindex] = ]
set scanstart [lindex $vlist 1]
set scanstep [lindex $vlist 2]
::scan::hdb_bmonscan -set NP $numpoints
::scan::hdb_bmonscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]];
::scan::hdb_bmonscan -set scan_start $scanstart
::scan::hdb_bmonscan -set scan_increment $scanstep
set scanvar_pts [SplitReply [$sobj getvardata $varindex]]
::scan::hdb_bmonscan -set feedback status BUSY
run_mode "bmonscan"
array set bm_fb [::scan::hdb_bmonscan -list feedback]
set ::histogram_memory::histmem_axes(SVAR) [SplitReply [sicslist [lindex $::scan::scanvarlist 0] hdb_path] ]
::nexus::newfile BEAM_MONITOR $save_filetype
#stdscan prepare $sobj $uobj;
foreach sv $scanvarlist scanstart $scanstartlist scanstep $scansteplist {
clientput "Scanvar: $sv start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
}
clientput "Datatype: BEAM_MONITOR"
}] {
run_mode "normal"
return -code error $::errorInfo
}
} else {
return -code error "BMONSCAN ABORTED: Instrument not ready"
}
}
Publish ::scan::hmm_count user
Publish ::scan::hmm_scan_prepare user
Publish ::scan::hmm_scan_finish user
Publish ::scan::hmm_scan_collect user
Publish ::scan::hmm_writepoint user
Publish ::scan::donothing user
Publish ::scan::bm_scan_prepare user
Publish ::scan::bm_scan_finish user
Publish ::scan::bm_scan_collect user
Publish ::scan::bm_writepoint user
Publish ::scan::bm_count user
namespace eval scan {
namespace export runscan mscan
VarMake ::scan::runscan_reset_position Text internal
::scan::runscan_reset_position false
# Utility to check the type of an argument
# returns true or raises an error if the type is invalid
proc checkarg {arg type errmsg} {
if {[string length $arg] == 0} {
error "Not enough arguments"
}
if {$type == "varname"} {
if [ string is alpha [string index $arg 0] ] {
set type "wordchar"
} else {
error $errmsg
}
}
if [string is $type $arg] {
return 1
} else {
error $errmsg
}
}
##
# @brief Sets up and runs an hmscan or bmonscan object from a list of scan variables
# and parameters
proc doscan {scanvarlist startlist steplist numpoints mode preset args} {
variable ic_hmm_datatype
variable save_filetype
variable force_scan
foreach scanvar $scanvarlist {
if {[is_drivable $scanvar] == 0} {
error "The scan variable <$scanvar> must be drivable"
}
}
if {[string is integer $numpoints] != 1} {
error "Number of points <$numpoints> must be an integer"
}
if { $numpoints < 1 } {
error "Number of points <$numpoints> must not be less than one"
}
set save_filetype data
foreach {arg val} $args {
switch $arg {
"force" {
if [string is boolean $val] {
set force_scan $val
} else {
error "ERROR: force must be true or false"
}
}
"datatype" {
set ic_hmm_datatype $val
}
"savetype" {
switch $val {
"save" {
set save_filetype data
}
"nosave" {
set save_filetype scratch
}
default {
error "ERROR: $arg $val, valid values for $arg are 'save' or 'nosave'"
}
}
}
default {
error "ERROR: $arg should be 'datatype' 'savetype' or 'force'"
}
}
}
set det_type [::scan::runscan_cmd -get detector]
if {$det_type == "histmem"} {
# hmscan ignores mode and preset, we use FAT_COUNT_METHOD and FAT_COUNT_STOP
::histogram_memory::count_method $mode
::histogram_memory::count_size $preset
hmscan clear
foreach scanvar $scanvarlist start $startlist step $steplist {
hmscan add $scanvar $start $step
}
} elseif {$det_type == "bmon"} {
set mode [string tolower $mode]
switch -glob $mode {
"time" { set bms_mode "timer" }
"monitor" { set bms_mode "monitor" }
default {return -code error "ERROR: mode should be 'time' or 'monitor' not $mode"}
}
bmonscan clear
foreach scanvar $scanvarlist start $startlist step $steplist {
bmonscan add $scanvar $start $step
}
} else {
return -code error "ERROR: detector type should be 'histmem' or 'bmon' not $det_type"
}
if {$det_type == "histmem"} {
hmscan run $numpoints timer 0
} else {
bmonscan run $numpoints $bms_mode $preset
}
}
## Multi-variable runscan
proc mscan {scanvar start step args} {
variable ic_hmm_datatype
variable reset_position
variable force_scan
variable scanvarlist
variable startlist
variable steplist
variable scaninitposlist
set scanvarlist {}
set startlist {}
set steplist {}
set scaninitposlist {}
if [ catch {
set force_scan false
set hm_ft_names [array names ::nexus::histmem_filetype_spec]
# Default filetype for histogram memory scans
set ic_hmm_datatype "HISTOGRAM_XYT"
# Default save uniquely numbered files
set savetype "save"
set reset_position [SplitReply [::scan::runscan_reset_position]]
checkarg $scanvar varname "Expecting a scan variable name, not $scanvar"
checkarg $start double "Expecing a float for $scanvar start value, not $start"
checkarg $step double "Expecing a float for $scanvar step value, not $step"
lappend scanvarlist $scanvar
lappend startlist $start
lappend steplist $step
for {set argindex 0} {1} {incr argindex 3} {
set par [lindex $args $argindex]
if {[string length $par] == 0} {
error "Not enough arguments"
} elseif [string is double $par] {
set numpoints $par
incr argindex
break
}
set err "Expecting another scan variable name or number of scanpoints instead of $par"
checkarg $par varname $err
lappend scanvarlist [lindex $args $argindex]
set start [lindex $args $argindex+1]
if {![string is double $start]} {
error "Scan variable start value should be a float, not $start"
}
lappend startlist $start
set step [lindex $args $argindex+2]
if {![string is double $step]} {
error "Scan variable step value should be a float, not $step"
}
lappend steplist $step
}
set mode [lindex $args $argindex]
incr argindex
checkarg $mode alpha "Expecting mode but got $mode"
set preset [lindex $args $argindex]
incr argindex
checkarg $preset double "Expecting preset but got $preset"
foreach scanvar $scanvarlist {
lappend scaninitposlist [SplitReply [$scanvar]]
}
# The {*}[...] below uses the Tcl8.5 expand operator {*} to pass a list as separate arguments
doscan $scanvarlist $startlist $steplist $numpoints $mode $preset {*}[lrange $args $argindex end]
} message ] {
set force_scan false
return -code error "ERROR [info level 0]\n$message"
} else {
set force_scan false
return $message
}
}
#TODO Add counter (monitor_1 monitor_2 ... histmem) and filetype BEAM_MONITOR HISTMEM_?
##
# @brief Run a histogram memory scan
# @param filetype one of the histogram filetypes (default=HISTOGRAM_XYT)
# @param savetype save/nosave (default=save)
# @param force true/false (default=false)
proc runscan {scanvar start stop numpoints mode preset args} {
variable ic_hmm_datatype
variable save_filetype
variable reset_position
variable force_scan
variable scanvarlist
variable startlist
variable steplist
variable scaninitposlist
set scanvarlist {}
set startlist {}
set steplist {}
set scaninitposlist {}
if [ catch {
set force_scan false
set hm_ft_names [array names ::nexus::histmem_filetype_spec]
# Default filetype for histogram memory scans
set ic_hmm_datatype "HISTOGRAM_XYT"
# Default save uniquely numbered files
set savetype "save"
set reset_position [SplitReply [::scan::runscan_reset_position]]
if {[is_drivable $scanvar] == 0} {
error "The scan variable <$scanvar> must be drivable"
}
lappend scanvarlist $scanvar
lappend startlist $start
if {[string is integer $numpoints] != 1} {
error "Number of points <$numpoints> must be an integer"
}
if { $numpoints < 1 } {
error "Number of points <$numpoints> must not be less than one"
}
if {$numpoints == 1} {
set step 0
} else {
set step [expr double($stop - $start)/($numpoints - 1.0)]
}
lappend steplist $step
if {$step == 0 && $numpoints > 1} {
clientput "WARNING:Scan step is zero and number of points > 1. Adjusting numpoints to one"
set numpoints 1
}
set save_filetype data
foreach {arg val} $args {
switch $arg {
"force" {
if [string is boolean $val] {
set force_scan $val
} else {
error "ERROR: force must be true or false"
}
}
"datatype" {
set ic_hmm_datatype $val
}
"savetype" {
switch $val {
"save" {
set save_filetype data
}
"nosave" {
set save_filetype scratch
}
default {
error "ERROR: $arg $val, valid values for $arg are 'save' or 'nosave'"
}
}
}
default {
error "ERROR: $arg should be 'datatype' 'savetype' or 'force'"
}
}
}
set det_type [::scan::runscan_cmd -get detector]
if {$det_type == "histmem"} {
# hmscan ignores mode and preset, we use FAT_COUNT_METHOD and FAT_COUNT_STOP
::histogram_memory::count_method $mode
::histogram_memory::count_size $preset
hmscan clear
hmscan add $scanvar $start $step
} elseif {$det_type == "bmon"} {
set mode [string tolower $mode]
switch -glob $mode {
"time" { set bms_mode "timer" }
"monitor" { set bms_mode "monitor" }
default {return -code error "ERROR: mode should be 'time' or 'monitor' not $mode"}
}
bmonscan clear
bmonscan add $scanvar $start $step
} else {
return -code error "ERROR: detector type should be 'histmem' or 'bmon' not $det_type"
}
lappend scaninitposlist [SplitReply [$scanvar]]
::scan::runscan_cmd -set numpoints $numpoints
::scan::runscan_cmd -set scan_variable $scanvar
::scan::runscan_cmd -set scan_start $start
::scan::runscan_cmd -set scan_stop $stop
::scan::runscan_cmd -set feedback scan_step $step
::scan::runscan_cmd -set mode $mode
::scan::runscan_cmd -set preset $preset
if {$det_type == "histmem"} {
hmscan run $numpoints timer 0
} else {
bmonscan run $numpoints $bms_mode $preset
}
} message ] {
set force_scan false
return -code error "ERROR [info level 0]\n$message"
} else {
set force_scan false
return $message
}
}
}
namespace import ::scan::runscan
namespace import ::scan::mscan
publish runscan user
publish mscan user
sicslist setatt runscan privilege internal