63 lines
1.6 KiB
Tcl
63 lines
1.6 KiB
Tcl
#----------------------------------------------------------------------------
|
|
# suchscan : a very fast scan. A motor is set to run, the counter is started
|
|
# and the counter read as fast as possible. Current motor position and
|
|
# counts are printed. For quick and dirty location of peaks.
|
|
#
|
|
# Mark Koennecke, October 1998
|
|
#---------------------------------------------------------------------------
|
|
|
|
proc scGetNum { text } {
|
|
set list [split $text =]
|
|
return [lindex $list 1]
|
|
}
|
|
|
|
|
|
# set the counter name
|
|
set ctr counter
|
|
|
|
#----------- check if var still driving
|
|
proc runtest {var } {
|
|
set t [listexe]
|
|
if {[string first $var $t] >= 0} {
|
|
return 1
|
|
} else {
|
|
return 0
|
|
}
|
|
}
|
|
#-------------------------- the actual susca
|
|
proc susca args {
|
|
global ctr
|
|
if {[llength $args] < 4} {
|
|
ClientPut "USAGE: susca var start length time"
|
|
error "ERROR: Insufficient number of arguments to susca"
|
|
}
|
|
#------ drive to start position
|
|
set var [lindex $args 0]
|
|
set start [lindex $args 1]
|
|
set end [lindex $args 2]
|
|
set ctime [lindex $args 3]
|
|
set ret [catch {drive $var $start} msg]
|
|
if {$ret != 0 } {
|
|
error "ERROR: $msg"
|
|
}
|
|
set last 0
|
|
#------- start counter
|
|
$ctr setmode timer
|
|
$ctr countnb $ctime
|
|
#-------- start motor
|
|
set ret [catch {run $var $end} msg]
|
|
if {$ret != 0 } {
|
|
error "ERROR: $msg"
|
|
}
|
|
#------ scan loop
|
|
while {[runtest $var] == 1} {
|
|
set ct [scGetNum [$ctr getcounts]]
|
|
set ncts [expr abs($ct - $last)]
|
|
set last $ct
|
|
set vp [scGetNum [$var]]
|
|
ClientPut [format "%8.2f %12.2f" $vp $ncts]
|
|
}
|
|
ClientPut "OK"
|
|
}
|
|
|