bde19bb973
- A couple of TAS fixes - o2t was fixed to work with any drivable - FOCUS was mended to include beam monitor in data file
543 lines
16 KiB
Tcl
543 lines
16 KiB
Tcl
#--------------------------------------------------------------------------
|
|
# general scan command wrappers for TOPSI and the like.
|
|
# New version using the object.tcl system from sntl instead of obTcl which
|
|
# caused a lot of trouble with tcl8.0
|
|
#
|
|
# Requires the built in scan command xxxscan.
|
|
#
|
|
# Mark Koennecke, February 2000
|
|
#--------------------------------------------------------------------------
|
|
|
|
#---------- adapt to the local settings
|
|
set home /data/koenneck/src
|
|
|
|
source $home/sics/object.tcl
|
|
|
|
set datapath $home/tmp
|
|
set recoverfil $home/tmp/recover.bin
|
|
|
|
#-------------------------- some utility functions -------------------------
|
|
proc MC { t n } {
|
|
set string $t
|
|
for { set i 1 } { $i < $n } { incr i } {
|
|
set string [format "%s%s" $string $t]
|
|
}
|
|
return $string
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
proc GetNum { text } {
|
|
set list [split $text =]
|
|
return [lindex $list 1]
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
|
|
|
|
#************** Definition of scan class **********************************
|
|
|
|
object_class ScanCommand {
|
|
member Mode Monitor
|
|
member NP 1
|
|
member counter counter
|
|
member NoVar 0
|
|
member Preset 10000
|
|
member File default.dat
|
|
member pinterest ""
|
|
member Channel 0
|
|
member Active 0
|
|
member Recover 0
|
|
member scanvars
|
|
member scanstart
|
|
member scanstep
|
|
member pinterest
|
|
|
|
method var {name start step} {
|
|
# check for activity
|
|
if {$slot(Active)} {
|
|
ClientPut "ERROR: cannot change parameters while scanning" error
|
|
return
|
|
}
|
|
# check parameters
|
|
set t [SICSType $name]
|
|
if { [string compare $t DRIV] != 0 } {
|
|
ClientPut [format "ERROR: %s is not drivable" $name] error
|
|
return 0
|
|
}
|
|
set t [SICSType $start]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: %s is no number!" $start] error
|
|
return 0
|
|
}
|
|
set t [SICSType $step]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: %s is no number!" $step] error
|
|
return 0
|
|
}
|
|
# install the variable
|
|
set i $slot(NoVar)
|
|
incr slot(NoVar)
|
|
lappend slot(scanvars) $name
|
|
lappend slot(scanstart) $start
|
|
lappend slot(scanstep) $step
|
|
$self SendInterest pinterest ScanVarChange
|
|
ClientPut OK
|
|
}
|
|
|
|
method info {} {
|
|
if { $slot(NoVar) < 1 } {
|
|
return "0,1,NONE,0.,0.,default.dat"
|
|
}
|
|
append result $slot(NP) "," $slot(NoVar)
|
|
for {set i 0} { $i < $slot(NoVar) } { incr i} {
|
|
append result "," [lindex $slot(scanvars) $i]
|
|
}
|
|
append result "," [lindex $slot(scanstart) 0] "," \
|
|
[lindex $slot(scanstep) 0]
|
|
set r1 [xxxscan getfile]
|
|
set l1 [split $r1 "="]
|
|
append result "," [lindex $l1 1]
|
|
return $result
|
|
}
|
|
|
|
method getvars {} {
|
|
set list ""
|
|
lappend list $slot(scanvars)
|
|
return [format "scan.Vars = %s -END-" $list]
|
|
}
|
|
|
|
method xaxis {} {
|
|
if { $slot(NoVar) <= 0} {
|
|
#---- default Answer
|
|
set t [format "%s.xaxis = %f %f" $self 0 1]
|
|
} else {
|
|
set t [format "%s.xaxis = %f %f" $self [lindex $slot(scanstart) 0] \
|
|
[lindex $slot(scanstep) 0] ]
|
|
}
|
|
ClientPut $t
|
|
}
|
|
|
|
method cinterest {} {
|
|
xxxscan interest
|
|
}
|
|
|
|
method uuinterest {} {
|
|
xxxscan uuinterest
|
|
}
|
|
|
|
method pinterest {} {
|
|
set nam [GetNum [config MyName]]
|
|
lappend $slot(pinterest) $nam
|
|
}
|
|
|
|
method SendInterest { type text } {
|
|
#------ check list first
|
|
set l1 $slot($type)
|
|
set l2 ""
|
|
foreach e $l1 {
|
|
set b [string trim $e]
|
|
set g [string trim $b "{}"]
|
|
set ret [SICSType $g]
|
|
if { [string first COM $ret] >= 0 } {
|
|
lappend l2 $e
|
|
}
|
|
}
|
|
#-------- update scan data and write
|
|
set slot($type) $l2
|
|
foreach e $l2 {
|
|
set b [string trim $e]
|
|
$b put $text
|
|
}
|
|
}
|
|
|
|
method mode { {NewVal NULL} } {
|
|
if { [string compare $NewVal NULL] == 0 } {
|
|
set val [format "%s.Mode = %s" $self $slot(Mode)]
|
|
ClientPut $val
|
|
return $val
|
|
} else {
|
|
# check for activity
|
|
if {$slot(Active)} {
|
|
ClientPut "ERROR: cannot change parameters while scanning" error
|
|
return
|
|
}
|
|
set tmp [string tolower $NewVal]
|
|
set NewVal $tmp
|
|
if { ([string compare $NewVal "timer"] == 0) || \
|
|
([string compare $NewVal monitor] ==0) } {
|
|
set slot(Mode) $NewVal
|
|
ClientPut OK
|
|
} else {
|
|
ClientPut [format "ERROR: %s not recognized as ScanMode" $NewVal]
|
|
}
|
|
}
|
|
}
|
|
|
|
method np { { NewVal NULL } } {
|
|
if { [string compare $NewVal NULL] == 0 } {
|
|
set val [format "%s.NP = %d" $self $slot(NP)]
|
|
ClientPut $val
|
|
return $val
|
|
} else {
|
|
# check for activity
|
|
if {$slot(Active)} {
|
|
ClientPut "ERROR: cannot change parameters while scanning" error
|
|
return
|
|
}
|
|
set t [SICSType $NewVal]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: %s is no number" $NewVal] error
|
|
return
|
|
}
|
|
set slot(NP) $NewVal
|
|
ClientPut OK
|
|
}
|
|
}
|
|
|
|
method preset { {NewVal NULL} } {
|
|
if { [string compare $NewVal NULL] == 0 } {
|
|
set val [format "%s.Preset = %f" $self $slot(Preset)]
|
|
ClientPut $val
|
|
return $val
|
|
} else {
|
|
# check for activity
|
|
if {$slot(Active)} {
|
|
ClientPut "ERROR: cannot change parameters while scanning" error
|
|
return
|
|
}
|
|
set t [SICSType $NewVal]
|
|
if { [string compare $t NUM] != 0} {
|
|
ClientPut [format "ERROR: %s is no number" $NewVal] error
|
|
return
|
|
}
|
|
set slot(Preset) $NewVal
|
|
ClientPut OK
|
|
}
|
|
}
|
|
|
|
method file {} {
|
|
return [xxxscan file]
|
|
}
|
|
|
|
method setchannel {num} {
|
|
set ret [catch {xxxscan setchannel $num} msg]
|
|
if { $ret == 0} {
|
|
set slot(Channel) $num
|
|
} else {
|
|
return $msg
|
|
}
|
|
}
|
|
|
|
method list { } {
|
|
ClientPut [format "%s.Preset = %f" $self $slot(Preset)]
|
|
ClientPut [format "%s.Mode = %s" $self $slot(Mode)]
|
|
ClientPut [format "%s.File = %s" $self $slot(File)]
|
|
ClientPut [format "%s.NP = %d" $self $slot(NP)]
|
|
ClientPut [format "%s.Channel = %d" $self $slot(Channel)]
|
|
ClientPut "ScanVariables:"
|
|
for { set i 0 } {$i < $slot(NoVar) } { incr i } {
|
|
ClientPut [format " %s %f %f" [lindex $slot(scanvars) $i] \
|
|
[lindex $slot(scanstart) $i] \
|
|
[lindex $slot(scanstep) $i] ]
|
|
}
|
|
}
|
|
|
|
method clear {} {
|
|
# check for activity
|
|
if {$slot(Active)} {
|
|
ClientPut "ERROR: cannot clear running scan" error
|
|
return
|
|
}
|
|
|
|
set slot(NP) 0
|
|
set slot(NoVar) 0
|
|
set slot(scanvars) ""
|
|
set slot(scanstart) ""
|
|
set slot(scanstep) ""
|
|
$self SendInterest pinterest ScanVarChange
|
|
xxxscan clear
|
|
ClientPut OK
|
|
}
|
|
|
|
method getcounts {} {
|
|
return [xxxscan getcounts]
|
|
}
|
|
|
|
method run { } {
|
|
# start with error checking
|
|
if { $slot(NP) < 1 } {
|
|
ClientPut "ERROR: Insufficient Number of ScanPoints"
|
|
return
|
|
}
|
|
if { $slot(NoVar) < 1 } {
|
|
ClientPut "ERROR: No variables to scan given!"
|
|
return
|
|
}
|
|
#------- check for activity
|
|
if {$slot(Active)} {
|
|
ClientPut "ERROR: Scan already in progress" error
|
|
return
|
|
}
|
|
xxxscan clear
|
|
for {set i 0 } { $i < $slot(NoVar)} {incr i} {
|
|
set ret [catch {xxxscan add [lindex $slot(scanvars) $i] \
|
|
[lindex $slot(scanstart) $i] [lindex $slot(scanstep) $i]} msg]
|
|
if {$ret != 0} {
|
|
set slot(Active) 0
|
|
error $msg
|
|
}
|
|
}
|
|
set slot(Active) 1
|
|
set ret [catch \
|
|
{xxxscan run $slot(NP) $slot(Mode) $slot(Preset)} msg]
|
|
set slot(Active) 0
|
|
if {$ret != 0 } {
|
|
error $msg
|
|
} else {
|
|
return "Scan Finished"
|
|
}
|
|
}
|
|
|
|
method recover {} {
|
|
set slot(Active) 1
|
|
catch {xxxscan recover} msg
|
|
set slot(Active) 0
|
|
return "Scan Finished"
|
|
}
|
|
|
|
method forceclear {} {
|
|
set slot(Active) 0
|
|
}
|
|
}
|
|
#---- end of ScanCommand definition
|
|
|
|
#********************** initialisation of module commands to SICS **********
|
|
|
|
set ret [catch {scan list} msg]
|
|
#if {$ret != 0} {
|
|
object_new ScanCommand scan
|
|
Publish scan Spy
|
|
VarMake lastscancommand Text User
|
|
Publish scancounts Spy
|
|
Publish textstatus Spy
|
|
Publish cscan User
|
|
Publish sscan User
|
|
Publish sftime Spy
|
|
Publish scaninfo Spy
|
|
Publish wwwsics Spy
|
|
#}
|
|
|
|
#*************************************************************************
|
|
|
|
#===================== Helper commands for status display work ============
|
|
# a new user command which allows status clients to read the counts in a scan
|
|
# This is just to circumvent the user protection on scan
|
|
proc scancounts { } {
|
|
set status [ catch {scan getcounts} result]
|
|
if { $status == 0 } {
|
|
return $result
|
|
} else {
|
|
return "scan.Counts= 0"
|
|
}
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# This is just another utilility function which helps in implementing the
|
|
# status display client
|
|
proc textstatus { } {
|
|
set text [status]
|
|
return [format "Status = %s" $text]
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# Dumps time in a useful format
|
|
proc sftime {} {
|
|
return [format "sicstime = %s" [sicstime]]
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
# Utility function which gives scan parameters as an easily parsable
|
|
# comma separated list for java status client
|
|
proc scaninfo {} {
|
|
set result [scan info]
|
|
set r1 [sample]
|
|
set inf [string first = $r1]
|
|
if {$inf > 0} {
|
|
incr inf
|
|
set sa [string range $r1 $inf end]
|
|
} else {
|
|
set sa Unknown
|
|
}
|
|
regsub -all , $sa " " sam
|
|
append result "," $sam
|
|
append result "," [sicstime]
|
|
set r1 [lastscancommand]
|
|
set l1 [split $r1 "="]
|
|
append result "," [lindex $l1 1]
|
|
return [format "scaninfo = %s" $result]
|
|
}
|
|
#----------------------------------------------------------------------
|
|
# wwwsics is a procedure which formats the most important status
|
|
# information for the WWW-status.
|
|
proc wwwsics {} {
|
|
#----- get all the data we need
|
|
set user [GetNum [user]]
|
|
set sample [GetNum [sample]]
|
|
set tit [GetNum [title]]
|
|
set ret [catch {lambda} msg]
|
|
if {$ret != 0 } {
|
|
set lam Undetermined
|
|
} else {
|
|
set lam [GetNum $msg]
|
|
}
|
|
set lscan [GetNum [lastscancommand]]
|
|
set svar [GetNum [scan getvars]]
|
|
set ind [string last -END- $svar]
|
|
if { $ind > 2 } {
|
|
set svar [string range $svar 0 $ind]
|
|
} else {
|
|
set svar " "
|
|
}
|
|
set res [scan info]
|
|
set l [split $res ,]
|
|
set fil [lindex $l 5]
|
|
set run [GetNum [sicsdatanumber]]
|
|
set stat [GetNum [status]]
|
|
#------- html format the reply
|
|
append result "<table BORDER=2>"
|
|
append result <tr> <th>Run Number</th> <td> $run </td> </tr>
|
|
append result <tr> <th>Title</th> <td> $tit </td> </tr>
|
|
append result <tr> <th>User</th> <td> $user </td> </tr>
|
|
append result <tr> <th>Sample </th> <td> $sample </td> </tr>
|
|
append result <tr> <th>wavelength</th> <td> $lam</td> </tr>
|
|
append result <tr> <th>Status</th> <td> $stat</td> </tr>
|
|
append result <tr> <th>Scan Variables</th> <td> $svar</td> </tr>
|
|
append result <tr> <th>File </th> <td> $fil</td> </tr>
|
|
append result <tr> <th>Last Scan Command</th> <td> $lscan</td> </tr>
|
|
append result </table>
|
|
return $result
|
|
}
|
|
#===================== Syntactical sugar around scan ===================
|
|
# center scan. A convenience scan for the one and only Daniel Clemens
|
|
# at TOPSI. Scans around a given center point. Requires the scan command
|
|
# for TOPSI to work.
|
|
#
|
|
# another convenience scan:
|
|
# sscan var1 start end var1 start end .... np preset
|
|
# scans var1, var2 from start to end with np steps and a preset of preset
|
|
#
|
|
# Mark Koennecke, August, 22, 1997
|
|
#-----------------------------------------------------------------------------
|
|
proc cscan { var center delta np preset } {
|
|
#------ start with some argument checking
|
|
set t [SICSType $var]
|
|
if { [string compare $t DRIV] != 0 } {
|
|
ClientPut [format "ERROR: %s is NOT drivable!" $var]
|
|
return
|
|
}
|
|
set t [SICSType $center]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: %s is no number!" $center]
|
|
return
|
|
}
|
|
set t [SICSType $delta]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: %s is no number!" $delta]
|
|
return
|
|
}
|
|
set t [SICSType $np]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: %s is no number!" $np]
|
|
return
|
|
}
|
|
set t [SICSType $preset]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: %s is no number!" $preset]
|
|
return
|
|
}
|
|
#-------- store command in lastscancommand
|
|
set txt [format "cscan %s %s %s %s %s" $var $center \
|
|
$delta $np $preset]
|
|
catch {lastscancommand $txt}
|
|
#-------- set standard parameters
|
|
scan clear
|
|
scan preset $preset
|
|
scan np [expr $np*2 + 1]
|
|
#--------- calculate start
|
|
set start [expr $center - $np * $delta]
|
|
set ret [catch {scan var $var $start $delta} msg]
|
|
if { $ret != 0} {
|
|
ClientPut $msg
|
|
return
|
|
}
|
|
#---------- start scan
|
|
set ret [catch {scan run} msg]
|
|
if {$ret != 0} {
|
|
error $msg
|
|
}
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
proc sscan args {
|
|
scan clear
|
|
#------- check arguments: the last two must be preset and np!
|
|
set l [llength $args]
|
|
if { $l < 5} {
|
|
ClientPut "ERROR: Insufficient number of arguments to sscan"
|
|
return
|
|
}
|
|
set preset [lindex $args [expr $l - 1]]
|
|
set np [lindex $args [expr $l - 2]]
|
|
set t [SICSType $preset]
|
|
ClientPut $t
|
|
ClientPut [string first $t "NUM"]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: expected number for preset, got %s" \
|
|
$preset]
|
|
return
|
|
}
|
|
set t [SICSType $np]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: expected number for np, got %s" \
|
|
$np]
|
|
return
|
|
}
|
|
scan preset $preset
|
|
scan np $np
|
|
#--------- do variables
|
|
set nvar [expr ($l - 2) / 3]
|
|
for { set i 0 } { $i < $nvar} { incr i } {
|
|
set var [lindex $args [expr $i * 3]]
|
|
set t [SICSType $var]
|
|
if {[string compare $t DRIV] != 0} {
|
|
ClientPut [format "ERROR: %s is not drivable" $var]
|
|
return
|
|
}
|
|
set start [lindex $args [expr ($i * 3) + 1]]
|
|
set t [SICSType $start]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: expected number for start, got %s" \
|
|
$start]
|
|
return
|
|
}
|
|
set end [lindex $args [expr ($i * 3) + 2]]
|
|
set t [SICSType $end]
|
|
if { [string compare $t NUM] != 0 } {
|
|
ClientPut [format "ERROR: expected number for end, got %s" \
|
|
$end]
|
|
return
|
|
}
|
|
#--------- do scan parameters
|
|
set step [expr double($end - $start)/double($np)]
|
|
set ret [catch {scan var $var $start $step} msg]
|
|
if { $ret != 0} {
|
|
ClientPut $msg
|
|
return
|
|
}
|
|
}
|
|
#------------- set lastcommand text
|
|
set txt [format "sscan %s" [join $args]]
|
|
catch {lastscancommand $txt}
|
|
#------------- start scan
|
|
set ret [catch {scan run} msg]
|
|
if {$ret != 0} {
|
|
error $msg
|
|
}
|
|
}
|
|
|
|
|