394 lines
12 KiB
Tcl
394 lines
12 KiB
Tcl
#----------------------------------------------------------------------------
|
|
# Scan command implementation for TOPSI
|
|
# Test version, Mark Koennecke, February 1997
|
|
# Revised to use the built in Scan command
|
|
# Mark Koennecke, October 1997
|
|
# Requires a sics scan command called xxxscan
|
|
#----------------------------------------------------------------------------
|
|
set home /data/koenneck/src/sics/tcl
|
|
set datapath /data/koenneck/tmp
|
|
set recoverfil /data/koenneck/tmp/recover.bin
|
|
|
|
|
|
source $home/utils.tcl
|
|
source $home/obtcl.tcl
|
|
source $home/base.tcl
|
|
source $home/inherit.tcl
|
|
#-------------------------- 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]
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# scan class initialization
|
|
class ScanCommand
|
|
|
|
ScanCommand method init { counter } {
|
|
instvar ScanData
|
|
instvar Active
|
|
instvar Recover
|
|
next
|
|
set ScanData(Mode) Timer
|
|
set ScanData(NP) 1
|
|
set ScanData(counter) $counter
|
|
set ScanData(NoVar) 0
|
|
set ScanData(Preset) 10.
|
|
set ScanData(File) Default.dat
|
|
set ScanData(pinterest) " "
|
|
set ScanData(Channel) 0
|
|
set Active 0
|
|
set Recover 0
|
|
}
|
|
#-------------add scan variables---------------------------------------------
|
|
ScanCommand method var { name start step } {
|
|
instvar ScanData
|
|
instvar ScanVar
|
|
instvar Active
|
|
# check for activity
|
|
if {$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 $ScanData(NoVar)
|
|
set ScanData(NoVar) [incr ScanData(NoVar)]
|
|
set ScanVar($i,Var) $name
|
|
set ScanVar($i,Start) $start
|
|
set ScanVar($i,Step) $step
|
|
set ScanVar($i,Value) " "
|
|
$self SendInterest pinterest ScanVarChange
|
|
ClientPut OK
|
|
}
|
|
ScanCommand method info {} {
|
|
instvar ScanData ScanVar
|
|
if { $ScanData(NoVar) < 1 } {
|
|
return "0,1,NONE,0.,0.,default.dat"
|
|
}
|
|
append result $ScanData(NP) "," $ScanData(NoVar)
|
|
for {set i 0} { $i < $ScanData(NoVar) } { incr i} {
|
|
append result "," $ScanVar($i,Var)
|
|
}
|
|
append result "," $ScanVar(0,Start) "," $ScanVar(0,Step)
|
|
set r1 [xxxscan getfile]
|
|
set l1 [split $r1 "="]
|
|
append result "," [lindex $l1 1]
|
|
return $result
|
|
}
|
|
#---------------------- getvars ------------------------------------------
|
|
ScanCommand method getvars {} {
|
|
instvar ScanData
|
|
instvar ScanVar
|
|
set list ""
|
|
for {set i 0} { $i < $ScanData(NoVar) } { incr i} {
|
|
lappend list $ScanVar($i,Var)
|
|
}
|
|
return [format "scan.Vars = %s -END-" $list]
|
|
}
|
|
#------------------------------------------------------------------------
|
|
ScanCommand method xaxis {} {
|
|
instvar ScanData
|
|
instvar ScanVar
|
|
if { $ScanData(NoVar) <= 0} {
|
|
#---- default Answer
|
|
set t [format "%s.xaxis = %f %f" $self 0 1]
|
|
} else {
|
|
set t [format "%s.xaxis = %f %f" $self $ScanVar(0,Start) \
|
|
$ScanVar(0,Step)]
|
|
}
|
|
ClientPut $t
|
|
}
|
|
#--------------------- modvar --------------------------------------------
|
|
ScanCommand method modvar {name start step } {
|
|
instvar ScanData
|
|
instvar ScanVar
|
|
for {set i 0} { $i < $ScanData(NoVar) } { incr i} {
|
|
if { [string compare $name $ScanVar($i,Var)] == 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
|
|
}
|
|
#-------- do it
|
|
set ScanVar($i,Start) $start
|
|
set ScanVar($i,Step) $step
|
|
return OK
|
|
}
|
|
}
|
|
error [format "Scan Variable %s NOT found" $name]
|
|
}
|
|
#----------------- interests ----------------------------------------------
|
|
ScanCommand method cinterest {} {
|
|
xxxscan interest
|
|
}
|
|
#----------------- interests ----------------------------------------------
|
|
ScanCommand method uuinterest {} {
|
|
xxxscan uuinterest
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
ScanCommand method pinterest {} {
|
|
instvar ScanData
|
|
set nam [GetNum [config MyName]]
|
|
lappend ScanData(pinterest) $nam
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
ScanCommand method SendInterest { type text } {
|
|
instvar ScanData
|
|
#------ check list first
|
|
set l1 $ScanData($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 ScanData($type) $l2
|
|
foreach e $l2 {
|
|
set b [string trim $e]
|
|
$b put $text
|
|
}
|
|
}
|
|
#---------------- Change Mode ----------------------------------------------
|
|
ScanCommand method mode { {NewVal NULL } } {
|
|
instvar ScanData
|
|
instvar Active
|
|
if { [string compare $NewVal NULL] == 0 } {
|
|
set val [format "%.Mode = %s" $self $ScanData(Mode)]
|
|
ClientPut $val
|
|
return $val
|
|
} else {
|
|
# check for activity
|
|
if {$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 ScanData(Mode) $NewVal
|
|
ClientPut OK
|
|
} else {
|
|
ClientPut [format "ERROR: %s not recognized as ScanMode" $NewVal]
|
|
}
|
|
}
|
|
}
|
|
#----------------------------- NP -------------------------------------------
|
|
ScanCommand method np { { NewVal NULL } } {
|
|
instvar ScanData
|
|
instvar Active
|
|
if { [string compare $NewVal NULL] == 0 } {
|
|
set val [format "%s.NP = %d" $self $ScanData(NP)]
|
|
ClientPut $val
|
|
return $val
|
|
} else {
|
|
# check for activity
|
|
if {$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 ScanData(NP) $NewVal
|
|
ClientPut OK
|
|
}
|
|
}
|
|
#------------------------------ Preset ------------------------------------
|
|
ScanCommand method preset { {NewVal NULL} } {
|
|
instvar ScanData
|
|
instvar Active
|
|
if { [string compare $NewVal NULL] == 0 } {
|
|
set val [format "%s.Preset = %f" $self $ScanData(Preset)]
|
|
ClientPut $val
|
|
return $val
|
|
} else {
|
|
# check for activity
|
|
if {$Active} {
|
|
ClientPut "ERROR: cannot change parameters while scanning" error
|
|
return
|
|
}
|
|
set ScanData(Preset) $NewVal
|
|
set t [SICSType $NewVal]
|
|
if { [string compare $t NUM] != 0} {
|
|
ClientPut [format "ERROR: %s is no number" $NewVal] error
|
|
return
|
|
}
|
|
ClientPut OK
|
|
}
|
|
}
|
|
#------------------------------ File ------------------------------------
|
|
ScanCommand method file { } {
|
|
return [xxxscan getfile]
|
|
}
|
|
#-------------------------------- channel --------------------------------
|
|
ScanCommand method setchannel {num} {
|
|
instvar ScanData
|
|
set ret [catch {xxxscan setchannel $num} msg]
|
|
if { $ret == 0} {
|
|
set ScanData(Channel) $num
|
|
} else {
|
|
return $msg
|
|
}
|
|
}
|
|
#-------------------------- list ------------------------------------------
|
|
ScanCommand method list { } {
|
|
instvar ScanData
|
|
instvar ScanVar
|
|
ClientPut [format "%s.Preset = %f" $self $ScanData(Preset)]
|
|
ClientPut [format "%s.Mode = %s" $self $ScanData(Mode)]
|
|
ClientPut [format "%s.File = %s" $self $ScanData(File)]
|
|
ClientPut [format "%s.NP = %d" $self $ScanData(NP)]
|
|
ClientPut [format "%s.Channel = %d" $self $ScanData(Channel)]
|
|
ClientPut "ScanVariables:"
|
|
for { set i 0 } {$i < $ScanData(NoVar) } { incr i } {
|
|
ClientPut [format " %s %f %f" $ScanVar($i,Var) $ScanVar($i,Start) \
|
|
$ScanVar($i,Step)]
|
|
}
|
|
}
|
|
#--------------------------------- clear ---------------------------------
|
|
ScanCommand method clear { } {
|
|
instvar ScanData
|
|
instvar ScanVar
|
|
instvar Data
|
|
instvar Active
|
|
# check for activity
|
|
if {$Active} {
|
|
ClientPut "ERROR: cannot clear running scan" error
|
|
return
|
|
}
|
|
|
|
set ScanData(NP) 0
|
|
set ScanData(NoVar) 0
|
|
set ScanData(Counts) " "
|
|
set ScanData(Monitor) " "
|
|
$self SendInterest pinterest ScanVarChange
|
|
xxxscan clear
|
|
ClientPut OK
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
ScanCommand method getcounts { } {
|
|
return [xxxscan getcounts]
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
ScanCommand method run { } {
|
|
instvar ScanData
|
|
instvar ScanVar
|
|
instvar Active
|
|
# start with error checking
|
|
if { $ScanData(NP) < 1 } {
|
|
ClientPut "ERROR: Insufficient Number of ScanPoints"
|
|
return
|
|
}
|
|
if { $ScanData(NoVar) < 1 } {
|
|
ClientPut "ERROR: No variables to scan given!"
|
|
return
|
|
}
|
|
#------- check for activity
|
|
if {$Active} {
|
|
ClientPut "ERROR: Scan already in progress" error
|
|
return
|
|
}
|
|
set Active 1
|
|
xxxscan clear
|
|
for {set i 0 } { $i < $ScanData(NoVar)} {incr i} {
|
|
set ret [catch {xxxscan add $ScanVar($i,Var) \
|
|
$ScanVar($i,Start) $ScanVar($i,Step)} msg]
|
|
if {$ret != 0} {
|
|
set Active 0
|
|
error $msg
|
|
}
|
|
}
|
|
set ret [catch \
|
|
{xxxscan run $ScanData(NP) $ScanData(Mode) $ScanData(Preset)}\
|
|
msg]
|
|
set Active 0
|
|
if {$ret != 0 } {
|
|
error $msg
|
|
} else {
|
|
return "Scan Finished"
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
ScanCommand method recover { } {
|
|
instvar Active
|
|
|
|
set Active 1
|
|
catch {xxxscan recover} msg
|
|
set Active 0
|
|
return "Scan Finished"
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# finally initialise the scan command
|
|
ScanCommand new scan counter
|
|
#---------------------------------------------------------------------------
|
|
# 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]
|
|
} |