499af28298
Tcl commands. Removed the broken obTcl object system and replaced it by
the object.tcl system from sntl. Redid the scan command with this. The
end of this is that SICS is now independent of the tcl version and
works with tcl 8.0 thus giving a factor of up to 10 in script execution
speed.
2.) Added driving an angle through a translation table (object lin2ang)
491 lines
14 KiB
Tcl
491 lines
14 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
|
|
}
|
|
set slot(Active) 1
|
|
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 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"
|
|
}
|
|
}
|
|
#---- 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
|
|
}
|
|
|
|
#*************************************************************************
|
|
|
|
#===================== 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 l1 [split $r1 "="]
|
|
append result "," [lindex $l1 1]
|
|
append result "," [sicstime]
|
|
set r1 [lastscancommand]
|
|
set l1 [split $r1 "="]
|
|
append result "," [lindex $l1 1]
|
|
return [format "scaninfo = %s" $result]
|
|
}
|
|
|
|
#===================== Syntactical sugar around scan ===================
|
|
# center scan. A convenience scan for the one and only Daniel Clemens
|
|
# at TOPSI. Scans around a given ceter 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
|
|
}
|
|
}
|
|
|
|
|