update for Lyrebird deployment
r3105 | jgn | 2011-04-20 08:48:12 +1000 (Wed, 20 Apr 2011) | 1 line
This commit is contained in:
Jing Chen
committed by
Douglas Clowes
Douglas Clowes
parent
9acffeb772
commit
8b1d0103f4
@@ -1,55 +0,0 @@
|
|||||||
proc select_environment_controller {envtemp} {
|
|
||||||
if [ catch {
|
|
||||||
puts "selecting $envtemp for environment control"
|
|
||||||
switch $envtemp {
|
|
||||||
"lh45" {
|
|
||||||
add_lh45 tc1 ca5-lyrebird 4003 1
|
|
||||||
proc ::histogram_memory::pre_count {} {
|
|
||||||
hset /sample/tc1/sensor/start_temperature [hval /sample/tc1/sensor/value]
|
|
||||||
hset /sample/tc1/sensor/end_temperature [hval /sample/tc1/sensor/value]
|
|
||||||
}
|
|
||||||
proc ::histogram_memory::post_count {} {
|
|
||||||
hset /sample/tc1/sensor/end_temperature [hval /sample/tc1/sensor/value]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
"rhqc" {
|
|
||||||
puts "Configuring RHQC"
|
|
||||||
# 9600 8 1 None None Enable
|
|
||||||
add_sct_ls340 tc1 ca5-[instname] 4001 "\r" 0.5 5.0
|
|
||||||
# TODO Set controlsensor
|
|
||||||
# if { [SplitReply [environment_simulation]] == "false"} {
|
|
||||||
# tc1 controlsensor sensorB
|
|
||||||
# }
|
|
||||||
# puts "Added tc1 with [tc1 controlsensor]"
|
|
||||||
# 9600 8 1 None None Enable
|
|
||||||
add_sct_ls340 tc2 ca5-[instname] 4002 "\r" 0.5 5.0
|
|
||||||
# TODO Set controlsensor
|
|
||||||
# if { [SplitReply [environment_simulation]] == "false"} {
|
|
||||||
# tc2 controlsensor sensorD
|
|
||||||
# }
|
|
||||||
# puts "Added tc2 with [tc2 controlsensor]"
|
|
||||||
}
|
|
||||||
"11TMagnet" {
|
|
||||||
puts "Configuring 11TMagnet"
|
|
||||||
add_sct_ls340 tc2 ca5-[instname] 4001 "\r" 0.5 5.0
|
|
||||||
if { [SplitReply [environment_simulation]] == "false"} {
|
|
||||||
::utility::macro::getset float temperature {} {
|
|
||||||
return [sicsmsgfmt [hval /sample/tc2/sensor/sensorValueA]]
|
|
||||||
}
|
|
||||||
sicslist setatt temperature long_name temperature
|
|
||||||
sicslist setatt temperature klass sample
|
|
||||||
sicslist setatt temperature units K
|
|
||||||
# TODO Set controlsensor
|
|
||||||
# tc1 controlsensor sensorA
|
|
||||||
# }
|
|
||||||
add_ips120 ips120 ca5-lyrebird 4004 0.001
|
|
||||||
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
clientput "Unknown environment controller $envtemp"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} msg ] {
|
|
||||||
puts "Failed to configure $envtemp: $msg"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -1,4 +0,0 @@
|
|||||||
# Author Jing Chen (jgn@ansto.gov.au)
|
|
||||||
|
|
||||||
source $cfPath(environment)/temperature/lakeshore340_common.tcl
|
|
||||||
|
|
||||||
@@ -32,23 +32,6 @@ if {$sim_mode == "true"} {
|
|||||||
MakeAsyncQueue mc4 DMC2280 $dmc2280_controller4(host) $dmc2280_controller4(port)
|
MakeAsyncQueue mc4 DMC2280 $dmc2280_controller4(host) $dmc2280_controller4(port)
|
||||||
}
|
}
|
||||||
|
|
||||||
# Beam stop gearing and signs (BS1=largest)
|
|
||||||
# 4,5 160:1
|
|
||||||
# 1,2,3 110:1
|
|
||||||
# MOTS need 400 steps per rev = 50000 steps per rev
|
|
||||||
set bs_steps_per_rev 50000.0
|
|
||||||
set bs1gear 160
|
|
||||||
set bs2gear 160
|
|
||||||
set bs3gear 110
|
|
||||||
set bs4gear 110
|
|
||||||
set bs5gear 110
|
|
||||||
|
|
||||||
set bs45_gear 110.0
|
|
||||||
set bs123_gear 160.0
|
|
||||||
#set bs45_gear 160.0
|
|
||||||
#set bs123_gear 110.0
|
|
||||||
set bs125sign -1
|
|
||||||
set bs34sign 1
|
|
||||||
|
|
||||||
#Measured absolute encoder reading at home position
|
#Measured absolute encoder reading at home position
|
||||||
set samchi_Home 7808328
|
set samchi_Home 7808328
|
||||||
@@ -79,57 +62,9 @@ set bs_cntsPerX [expr 32768.0/360.0]
|
|||||||
set bs_stepsPerX [expr -25000.0*160.0/360.0]
|
set bs_stepsPerX [expr -25000.0*160.0/360.0]
|
||||||
set pol_Home 7500000
|
set pol_Home 7500000
|
||||||
|
|
||||||
#HERE ARE THE LATEST VALUES
|
|
||||||
set pent_Home 8146159
|
|
||||||
# Guide Positions Mirrotron ffr 2009-07-18
|
|
||||||
set pc1_Guide 7995952
|
|
||||||
set pc1_Polarizer 7723328
|
|
||||||
set pc2_Guide 7459329
|
|
||||||
set pc2_Polarizer 7186701
|
|
||||||
set pc3_Guide 8440904
|
|
||||||
set pc4_Guide 6161076
|
|
||||||
set pc5_Guide 7856254
|
|
||||||
set pc6_Guide 8800665
|
|
||||||
set pc7_Guide 24167224
|
|
||||||
set pc8_Guide 8302146
|
|
||||||
set pc9_Guide 7851820
|
|
||||||
set pc10_Guide 25977227
|
|
||||||
|
|
||||||
#lens
|
|
||||||
set pc10_Lens 26196301
|
|
||||||
#lens_and_prism
|
#lens_and_prism
|
||||||
set pc10_LensandPrism 25729419
|
set pc10_LensandPrism 25729419
|
||||||
|
|
||||||
set pc3_Aperture 8304893
|
|
||||||
set pc4_Aperture 6029466
|
|
||||||
set pc5_Aperture 7728755
|
|
||||||
set pc6_Aperture 8663189
|
|
||||||
set pc7_Aperture 24036241
|
|
||||||
set pc8_Aperture 8169931
|
|
||||||
set pc9_Aperture 7718840
|
|
||||||
set pc10_Aperture 25835335
|
|
||||||
|
|
||||||
set pc1_Home $pc1_Guide
|
|
||||||
set pc2_Home $pc2_Guide
|
|
||||||
set pc3_Home $pc3_Guide
|
|
||||||
set pc4_Home $pc4_Guide
|
|
||||||
set pc5_Home $pc5_Guide
|
|
||||||
set pc6_Home $pc6_Guide
|
|
||||||
set pc7_Home $pc7_Guide
|
|
||||||
set pc8_Home $pc8_Guide
|
|
||||||
set pc9_Home $pc9_Guide
|
|
||||||
set pc10_Home $pc10_Guide
|
|
||||||
|
|
||||||
set pc1_Empty [expr ($pc1_Guide + $pc1_Polarizer)/2]
|
|
||||||
set pc2_Empty [expr ($pc2_Guide + $pc2_Polarizer)/2]
|
|
||||||
set pc3_Empty [expr (2 * $pc3_Guide) - $pc3_Aperture]
|
|
||||||
set pc4_Empty [expr (2 * $pc4_Guide) - $pc4_Aperture]
|
|
||||||
set pc5_Empty [expr (2 * $pc5_Guide) - $pc5_Aperture]
|
|
||||||
set pc6_Empty [expr (2 * $pc6_Guide) - $pc6_Aperture]
|
|
||||||
set pc7_Empty [expr (2 * $pc7_Guide) - $pc7_Aperture]
|
|
||||||
set pc8_Empty [expr (2 * $pc8_Guide) - $pc8_Aperture]
|
|
||||||
set pc9_Empty [expr (2 * $pc9_Guide) - $pc9_Aperture]
|
|
||||||
set pc10_Empty [expr (2 * $pc10_Guide) - $pc10_Aperture]
|
|
||||||
|
|
||||||
#Measured or computed step/count rates for collimator translation
|
#Measured or computed step/count rates for collimator translation
|
||||||
set coll_StepsPerX [expr -25000.0/6.0]
|
set coll_StepsPerX [expr -25000.0/6.0]
|
||||||
|
|||||||
@@ -1,8 +1,4 @@
|
|||||||
set sim_mode [SplitReply [plc_simulation]]
|
set sim_mode [SplitReply [plc_simulation]]
|
||||||
if {$sim_mode == "false"} {
|
|
||||||
MakeAsyncQueue plc_chan SafetyPLC 137.157.204.79 31001
|
|
||||||
MakeSafetyPLC plc plc_chan 0
|
|
||||||
}
|
|
||||||
|
|
||||||
source $cfPath(plc)/plc_common_1.tcl
|
source $cfPath(plc)/plc_common_1.tcl
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,77 @@
|
|||||||
|
proc AsciiPlot_findScale {ydatalist scale baseline} {
|
||||||
|
upvar $scale sc
|
||||||
|
upvar $baseline bl
|
||||||
|
set min +99999999.99
|
||||||
|
set max -99999999.99
|
||||||
|
foreach yval $ydatalist {
|
||||||
|
if {$yval > $max} {
|
||||||
|
set max $yval
|
||||||
|
}
|
||||||
|
if {$yval < $min} {
|
||||||
|
set min $yval
|
||||||
|
}
|
||||||
|
}
|
||||||
|
set sc [expr 61./($max-$min)]
|
||||||
|
set bl [expr int(-$min*$sc+1.)]
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
proc AsciiPlot_clearLine {line} {
|
||||||
|
upvar $line Zeile
|
||||||
|
for {set i 0} {$i < 64} {incr i} {
|
||||||
|
set Zeile($i) " "
|
||||||
|
}
|
||||||
|
set Zeile(64) "\n"
|
||||||
|
}
|
||||||
|
|
||||||
|
proc AsciiPlot_printLine {xtxt line} {
|
||||||
|
upvar $line Zeile
|
||||||
|
set txtline ""
|
||||||
|
set txtline "$txtline$xtxt"
|
||||||
|
for {set i 0} {$i <= 64} {incr i} {
|
||||||
|
set txtline "$txtline$Zeile($i)"
|
||||||
|
}
|
||||||
|
ClientPut $txtline
|
||||||
|
}
|
||||||
|
|
||||||
|
proc AsciiPlot_list {xdata ydata} {
|
||||||
|
AsciiPlot_findScale $ydata scale baseValue
|
||||||
|
set xty 0
|
||||||
|
set avgy 0
|
||||||
|
foreach xval $xdata yval $ydata {
|
||||||
|
set xty [expr $xty+$xval*$yval]
|
||||||
|
set avgy [expr $avgy+$yval]
|
||||||
|
AsciiPlot_clearLine line
|
||||||
|
set line(0) "!"
|
||||||
|
set height [expr int($yval*$scale+$baseValue)]
|
||||||
|
if {$height >= 1} {
|
||||||
|
if {$height < 69} {
|
||||||
|
set line($height) "*"
|
||||||
|
} else {
|
||||||
|
set line(68) "*"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
AsciiPlot_printLine [format %+#1.3e $xval] line
|
||||||
|
}
|
||||||
|
ClientPut "\ncenter of gravity = [expr 1.*$xty/$avgy]\n"
|
||||||
|
}
|
||||||
|
|
||||||
|
proc AsciiPlot_xydata2list {xydatalist xdata ydata} {
|
||||||
|
upvar $xdata xd
|
||||||
|
upvar $ydata yd
|
||||||
|
set xd {}
|
||||||
|
set yd {}
|
||||||
|
set xydl [$xydatalist list]
|
||||||
|
foreach {x y} $xydl {
|
||||||
|
lappend xd $x
|
||||||
|
lappend yd $y
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
proc AsciiPlot {data} {
|
||||||
|
AsciiPlot_xydata2list $data xdata ydata
|
||||||
|
AsciiPlot_list $xdata $ydata
|
||||||
|
}
|
||||||
|
|
||||||
|
Publish AsciiPlot Spy
|
||||||
|
alias asciiplot AsciiPlot
|
||||||
@@ -0,0 +1,112 @@
|
|||||||
|
#--------------------------------------------------------------
|
||||||
|
# This is the initialisation code for the ANDOR iKon-M
|
||||||
|
# camera and the CDDWWW WWW-server. It got separated into
|
||||||
|
# a separate file in order to support moving that camera around.
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2010
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
|
||||||
|
#source $scripthome/ccdwww.tcl
|
||||||
|
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
set ccdwww::initnodes [list daqmode camerano accucycle accucounts \
|
||||||
|
triggermode temperature imagepar shutterlevel \
|
||||||
|
shuttermode openingtime closingtime flip rotate \
|
||||||
|
hspeed vspeed vamp]
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc writecooler {} {
|
||||||
|
set target [sct target]
|
||||||
|
set status [ccdwww::httpsend "/ccd/cooling?status=$target"]
|
||||||
|
andisct queue /sics/andi/cooler read read
|
||||||
|
andisct queue /sics/andi/temperature read read
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc readcooler {} {
|
||||||
|
sct send "/ccd/iscooling"
|
||||||
|
return coolerreply
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc coolerreply {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {ccdwww::httptest $reply} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
clientput $data
|
||||||
|
} else {
|
||||||
|
catch {hdelprop [sct] geterror}
|
||||||
|
if {$data == 0} {
|
||||||
|
sct update off
|
||||||
|
} else {
|
||||||
|
sct update on
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc readtemp {} {
|
||||||
|
ccdwww::httpsend "/ccd/temperature"
|
||||||
|
return tempreply
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc tempreply {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {ccdwww::httptest $reply} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
clientput $data
|
||||||
|
} else {
|
||||||
|
catch {hdelprop [sct] geterror}
|
||||||
|
sct update $data
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc MakeAndorHM {name host } {
|
||||||
|
ccdwww::MakeCCDWWW $name $host "ccdwww::initscript $name"
|
||||||
|
hfactory /sics/$name/daqmode plain mugger text
|
||||||
|
hset /sics/$name/daqmode single
|
||||||
|
hfactory /sics/$name/camerano plain mugger int
|
||||||
|
hset /sics/$name/camerano 0
|
||||||
|
hfactory /sics/$name/accucycle plain mugger int
|
||||||
|
hset /sics/$name/accucycle 20
|
||||||
|
hfactory /sics/$name/accucounts plain mugger int
|
||||||
|
hset /sics/$name/accucounts 5
|
||||||
|
hfactory /sics/$name/triggermode plain mugger int
|
||||||
|
hset /sics/$name/triggermode 0
|
||||||
|
hfactory /sics/$name/temperature plain mugger int
|
||||||
|
hset /sics/$name/temperature -30
|
||||||
|
hfactory /sics/$name/imagepar plain mugger intar 6
|
||||||
|
hset /sics/$name/imagepar 1 1 1 1024 1 1024
|
||||||
|
hfactory /sics/$name/shutterlevel plain mugger int
|
||||||
|
hset /sics/$name/shutterlevel 0
|
||||||
|
hfactory /sics/$name/shuttermode plain mugger int
|
||||||
|
hset /sics/$name/shuttermode 0
|
||||||
|
hfactory /sics/$name/openingtime plain mugger int
|
||||||
|
hset /sics/$name/openingtime 20
|
||||||
|
hfactory /sics/$name/closingtime plain mugger int
|
||||||
|
hset /sics/$name/closingtime 20
|
||||||
|
hfactory /sics/$name/flip plain mugger intar 2
|
||||||
|
hset /sics/$name/flip 0 1
|
||||||
|
hfactory /sics/$name/rotate plain mugger int
|
||||||
|
hset /sics/$name/rotate 0
|
||||||
|
hfactory /sics/$name/hspeed plain mugger int
|
||||||
|
hset /sics/$name/hspeed 2
|
||||||
|
hfactory /sics/$name/vspeed plain mugger int
|
||||||
|
hset /sics/$name/vspeed 0
|
||||||
|
hfactory /sics/$name/vamp plain mugger int
|
||||||
|
hset /sics/$name/vamp 1
|
||||||
|
hfactory /sics/$name/cooler plain mugger text
|
||||||
|
hset /sics/$name/cooler off
|
||||||
|
hsetprop /sics/$name/cooler write writecooler
|
||||||
|
hsetprop /sics/$name/cooler httpreply ccdwww::httpreply
|
||||||
|
hsetprop /sics/$name/cooler read readcooler
|
||||||
|
hsetprop /sics/$name/cooler coolerreply coolerreply
|
||||||
|
${name}sct write /sics/$name/cooler
|
||||||
|
${name}sct poll /sics/$name/cooler 30
|
||||||
|
hfactory /sics/$name/sensor_temperature plain mugger float
|
||||||
|
hsetprop /sics/$name/sensor_temperature read readtemp
|
||||||
|
hsetprop /sics/$name/sensor_temperature tempreply tempreply
|
||||||
|
${name}sct poll /sics/$name/sensor_temperature 30
|
||||||
|
$name dim 1024 1024
|
||||||
|
$name init
|
||||||
|
}
|
||||||
@@ -0,0 +1,524 @@
|
|||||||
|
#--------------------------------------------------------------
|
||||||
|
# This is a new style driver for the Astrium chopper systems in
|
||||||
|
# the new sicsobj/scriptcontext based system. Please note that
|
||||||
|
# actual implementations may differ in the number of choppers
|
||||||
|
# and the address of the chopper on the network.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# SCRIPT CHAINS:
|
||||||
|
# - reading parameters:
|
||||||
|
# astchopread - readastriumchopperpar - readastriumchopperpar - ...
|
||||||
|
# - writing
|
||||||
|
# astchopwrite - astchopwritereply
|
||||||
|
#
|
||||||
|
# Another remark:
|
||||||
|
# In order for chosta to work properly, the chopperparlist and
|
||||||
|
# chopperlonglist must be aligned.
|
||||||
|
#
|
||||||
|
# Mark Koennecke, February 2009
|
||||||
|
#
|
||||||
|
# If something goes wrong with this, the following things ought
|
||||||
|
# to be checked:
|
||||||
|
# - Is the standard Tcl scan command been properly renamed to stscan?
|
||||||
|
# - Is a communication possible with the chopper via telnet?
|
||||||
|
# This may not be the case because of other SICS servers blocking
|
||||||
|
# things or the old driver being active and capturing the terminal
|
||||||
|
# server port in SerPortServer. Scriptcontext then fails silently.
|
||||||
|
# But may be we will fix the latter.
|
||||||
|
# - The other thing which happens is that the parameter list of
|
||||||
|
# the chopper differs in little ways between instances.
|
||||||
|
#
|
||||||
|
# Mark Koennecke, April 2009
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
MakeSICSObj choco AstriumChopper
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc astriumchopperputerror {txt} {
|
||||||
|
global choppers chopperparlist
|
||||||
|
foreach chopper $choppers {
|
||||||
|
foreach par $chopperparlist {
|
||||||
|
set path /sics/choco/${chopper}/${par}
|
||||||
|
hsetprop $path geterror $txt
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
# Paramamters look like: name value, entries for parameters are
|
||||||
|
# separated by ;
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc astriumsplitreply {chopper reply} {
|
||||||
|
set parlist [split [string trim $reply] ";"]
|
||||||
|
foreach par $parlist {
|
||||||
|
catch {stscan $par "%s %s" token val} count
|
||||||
|
if {[string first ERROR $count] < 0 && $count == 2} {
|
||||||
|
set val [string trim $val]
|
||||||
|
set token [string trim $token]
|
||||||
|
catch {hupdate /sics/choco/${chopper}/${token} $val}
|
||||||
|
catch {hdelprop /sics/choco/${chopper}/${token} geterror}
|
||||||
|
} else {
|
||||||
|
#-------- special fix for dphas and averl
|
||||||
|
if {[string first dphas $par] >= 0} {
|
||||||
|
set val [string range $par 5 end]
|
||||||
|
if {$val > 360} {
|
||||||
|
set val [expr $val -360.]
|
||||||
|
}
|
||||||
|
hupdate /sics/choco/${chopper}/dphas $val
|
||||||
|
hdelprop /sics/choco/${chopper}/dphas geterror
|
||||||
|
}
|
||||||
|
if {[string first averl $par] >= 0} {
|
||||||
|
set val [string range $par 5 end]
|
||||||
|
hupdate /sics/choco/${chopper}/averl $val
|
||||||
|
hdelprop /sics/choco/${chopper}/averl geterror
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
# update those parameters which are dependent on the chopper
|
||||||
|
# status just read. Some of them may or may not be there, this
|
||||||
|
# is why this is protected by catch'es.
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc astcopydependentpar {} {
|
||||||
|
global choppers
|
||||||
|
foreach chop $choppers {
|
||||||
|
set val [hval /sics/choco/${chop}/aspee]
|
||||||
|
catch {hupdate /sics/choco/${chop}/speed $val}
|
||||||
|
set val [hval /sics/choco/${chop}/nphas]
|
||||||
|
set dp [hval /sics/choco/${chop}/dphas]
|
||||||
|
set val [expr $val + $dp]
|
||||||
|
catch {hupdate /sics/choco/${chop}/phase $val}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc readastriumchopperpar {} {
|
||||||
|
global choppers
|
||||||
|
set reply [sct result]
|
||||||
|
if {[string first ERR $reply] >= 0} {
|
||||||
|
astriumchopperputerror $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
if {[string first "not valid" $reply] >= 0 } {
|
||||||
|
astriumchopperputerror "ERROR: chopper responded with not valid"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
set count [sct replycount]
|
||||||
|
if {$count == -1} {
|
||||||
|
sct send @@NOSEND@@
|
||||||
|
sct replycount 0
|
||||||
|
hupdate /sics/choco/asyst ""
|
||||||
|
hdelprop /sics/choco/asyst geterror
|
||||||
|
return astchoppar
|
||||||
|
} else {
|
||||||
|
set oldval [hval /sics/choco/asyst]
|
||||||
|
hupdate /sics/choco/asyst "$oldval $reply"
|
||||||
|
astriumsplitreply [lindex $choppers $count] $reply
|
||||||
|
incr count
|
||||||
|
sct replycount $count
|
||||||
|
if {$count < [llength $choppers] } {
|
||||||
|
sct send @@NOSEND@@
|
||||||
|
return astchoppar
|
||||||
|
} else {
|
||||||
|
astcopydependentpar
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc astchopread {} {
|
||||||
|
sct send "asyst 1"
|
||||||
|
sct replycount -1
|
||||||
|
return astchoppar
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc astriumMakeChopperParameters {} {
|
||||||
|
global choppers chopperparlist
|
||||||
|
foreach chopper $choppers {
|
||||||
|
hfactory /sics/choco/${chopper} plain spy none
|
||||||
|
foreach par $chopperparlist {
|
||||||
|
set path /sics/choco/${chopper}/${par}
|
||||||
|
hfactory $path plain internal text
|
||||||
|
chocosct connect $path
|
||||||
|
}
|
||||||
|
}
|
||||||
|
hfactory /sics/choco/asyst plain user text
|
||||||
|
hsetprop /sics/choco/asyst read astchopread
|
||||||
|
hsetprop /sics/choco/asyst astchoppar readastriumchopperpar
|
||||||
|
hfactory /sics/choco/stop plain user int
|
||||||
|
chocosct poll /sics/choco/asyst 60
|
||||||
|
#--------- This is for debugging
|
||||||
|
# chocosct poll /sics/choco/asyst 10
|
||||||
|
}
|
||||||
|
#=================== write support ==============================
|
||||||
|
proc astchopwrite {prefix} {
|
||||||
|
set val [sct target]
|
||||||
|
sct send "$prefix $val"
|
||||||
|
sct writestart 1
|
||||||
|
hupdate /sics/choco/stop 0
|
||||||
|
return astchopwritereply
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
# Make sure to send a status request immediatly after a reply in
|
||||||
|
# order to avoid timing problems
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc astchopwritereply {} {
|
||||||
|
set reply [sct result]
|
||||||
|
if {[string first ERR $reply] >= 0} {
|
||||||
|
sct print $reply
|
||||||
|
hupdate /sics/choco/stop 1
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
if {[string first "chopper error" $reply] >= 0} {
|
||||||
|
sct print "ERROR: $reply"
|
||||||
|
hupdate /sics/choco/stop 1
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
if {[string first "not valid" $reply] >= 0 } {
|
||||||
|
sct print "ERROR: chopper responded with not valid"
|
||||||
|
hupdate /sics/choco/stop 1
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
set state [sct writestart]
|
||||||
|
if {$state == 1} {
|
||||||
|
sct writestart 0
|
||||||
|
sct send "asyst 1"
|
||||||
|
sct replycount -1
|
||||||
|
return astchopwritereply
|
||||||
|
} else {
|
||||||
|
set status [readastriumchopperpar]
|
||||||
|
if {[string first idle $status] >= 0} {
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
return astchopwritereply
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc astchopcompare {path1 path2 delta} {
|
||||||
|
set v1 [hval $path1]
|
||||||
|
set v2 [hval $path2]
|
||||||
|
if {abs($v1 - $v2) < $delta} {
|
||||||
|
return 1
|
||||||
|
} else {
|
||||||
|
return 0
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc astchopcheckspeed {chopper} {
|
||||||
|
set stop [hval /sics/choco/stop]
|
||||||
|
if {$stop == 1} {
|
||||||
|
return fault
|
||||||
|
}
|
||||||
|
chocosct queue /sics/choco/asyst progress read
|
||||||
|
set tg [sct target]
|
||||||
|
set p1 /sics/choco/${chopper}/nspee
|
||||||
|
set p2 /sics/choco/${chopper}/aspee
|
||||||
|
set tst [astchopcompare $p1 $p2 50]
|
||||||
|
if {$tst == 1 } {
|
||||||
|
wait 1
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
return busy
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc astchopcheckphase {chopper} {
|
||||||
|
set stop [hval /sics/choco/stop]
|
||||||
|
if {$stop == 1} {
|
||||||
|
return fault
|
||||||
|
}
|
||||||
|
chocosct queue /sics/choco/asyst progress read
|
||||||
|
set p2 [hval /sics/choco/${chopper}/dphas]
|
||||||
|
if {abs($p2) < .03} {
|
||||||
|
wait 15
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
return busy
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc astchopcheckratio {} {
|
||||||
|
global choppers
|
||||||
|
set stop [hval /sics/choco/stop]
|
||||||
|
if {$stop == 1} {
|
||||||
|
return fault
|
||||||
|
}
|
||||||
|
set ch1 [lindex $choppers 0]
|
||||||
|
set ch2 [lindex $choppers 1]
|
||||||
|
chocosct queue /sics/choco/asyst progress read
|
||||||
|
set p1 [hval /sics/choco/${ch1}/aspee]
|
||||||
|
set p2 [hval /sics/choco/${ch2}/aspee]
|
||||||
|
set target [sct target]
|
||||||
|
if {$p2 < 10} {
|
||||||
|
return busy
|
||||||
|
}
|
||||||
|
if {abs($p1/$p2 - $target*1.) < .3} {
|
||||||
|
set tst 1
|
||||||
|
} else {
|
||||||
|
set tst 0
|
||||||
|
}
|
||||||
|
if {$tst == 1 } {
|
||||||
|
wait 1
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
return busy
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc astchopstop {} {
|
||||||
|
sct print "No real way to stop choppers but I will release"
|
||||||
|
sct send @@NOSEND@@
|
||||||
|
hupdate /sics/choco/stop 1
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc astspeedread {chopper} {
|
||||||
|
set val [hval /sics/choco/${chopper}/aspee]
|
||||||
|
sct update $val
|
||||||
|
sct send @@NOSEND@@
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc astchopspeedlimit {chidx} {
|
||||||
|
global choppers maxspeed
|
||||||
|
set chname [lindex $choppers $chidx]
|
||||||
|
set val [sct target]
|
||||||
|
if {$val < 0 || $val > $maxspeed} {
|
||||||
|
error "Desired chopper speed out of range"
|
||||||
|
}
|
||||||
|
if {$chidx > 0} {
|
||||||
|
set state [hval /sics/choco/${chname}/state]
|
||||||
|
if {[string first async $state] < 0} {
|
||||||
|
error "Chopper in wrong state"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc astMakeChopperSpeed1 {var} {
|
||||||
|
global choppers
|
||||||
|
set ch [lindex $choppers 0]
|
||||||
|
set path /sics/choco/${ch}/speed
|
||||||
|
hfactory $path plain mugger float
|
||||||
|
hsetprop $path read astspeedread $ch
|
||||||
|
hsetprop $path write astchopwrite "nspee 1 "
|
||||||
|
hsetprop $path astchopwritereply astchopwritereply
|
||||||
|
chocosct write $path
|
||||||
|
hsetprop $path checklimits astchopspeedlimit 0
|
||||||
|
hsetprop $path halt astchopstop
|
||||||
|
hsetprop $path checkstatus astchopcheckspeed $ch
|
||||||
|
hsetprop $path priv manager
|
||||||
|
makesctdriveobj $var $path DriveAdapter chocosct
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc astMakeChopperSpeed2 {var} {
|
||||||
|
global choppers
|
||||||
|
set ch [lindex $choppers 1]
|
||||||
|
set path /sics/choco/${ch}/speed
|
||||||
|
hfactory $path plain mugger float
|
||||||
|
hsetprop $path read astspeedread $ch
|
||||||
|
hsetprop $path write astchopwrite "nspee 2 "
|
||||||
|
hsetprop $path astchopwritereply astchopwritereply
|
||||||
|
chocosct write $path
|
||||||
|
hsetprop $path checklimits astchopspeedlimit 0
|
||||||
|
hsetprop $path halt astchopstop
|
||||||
|
hsetprop $path checkstatus astchopcheckspeed $ch
|
||||||
|
hsetprop $path priv manager
|
||||||
|
makesctdriveobj $var $path DriveAdapter chocosct
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc astchopphaselimit {} {
|
||||||
|
set val [sct target]
|
||||||
|
if {$val < -359.9 || $val > 359.9} {
|
||||||
|
error "chopper phase out of range"
|
||||||
|
}
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc astphaseread {chopper} {
|
||||||
|
set val [hval /sics/choco/${chopper}/aphas]
|
||||||
|
sct update $val
|
||||||
|
sct send @@NOSEND@@
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc astMakeChopperPhase1 {var} {
|
||||||
|
global choppers
|
||||||
|
set ch [lindex $choppers 0]
|
||||||
|
set path /sics/choco/${ch}/phase
|
||||||
|
hfactory $path plain mugger float
|
||||||
|
hsetprop $path read astphaseread $ch
|
||||||
|
hsetprop $path write astchopwrite "nphas 1 "
|
||||||
|
hsetprop $path astchopwritereply astchopwritereply
|
||||||
|
chocosct write $path
|
||||||
|
hsetprop $path checklimits astchopphaselimit
|
||||||
|
hsetprop $path halt astchopstop
|
||||||
|
hsetprop $path checkstatus astchopcheckphase $ch
|
||||||
|
hsetprop $path priv manager
|
||||||
|
makesctdriveobj $var $path DriveAdapter chocosct
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc astMakeChopperPhase2 {var} {
|
||||||
|
global choppers
|
||||||
|
set ch [lindex $choppers 1]
|
||||||
|
set path /sics/choco/${ch}/phase
|
||||||
|
hfactory $path plain mugger float
|
||||||
|
hsetprop $path read astphaseread $ch
|
||||||
|
hsetprop $path write astchopwrite "nphas 2 "
|
||||||
|
hsetprop $path astchopwritereply astchopwritereply
|
||||||
|
chocosct write $path
|
||||||
|
hsetprop $path checklimits astchopphaselimit
|
||||||
|
hsetprop $path halt astchopstop
|
||||||
|
hsetprop $path checkstatus astchopcheckphase $ch
|
||||||
|
hsetprop $path priv manager
|
||||||
|
makesctdriveobj $var $path DriveAdapter chocosct
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc astchopratiolimit {} {
|
||||||
|
set val [sct target]
|
||||||
|
if {$val < 1} {
|
||||||
|
error "Ratio out of range"
|
||||||
|
}
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc astMakeChopperRatio {var} {
|
||||||
|
global choppers
|
||||||
|
set ch [lindex $choppers 1]
|
||||||
|
set path /sics/choco/${ch}/Ratio
|
||||||
|
hdel $path
|
||||||
|
hfactory $path plain mugger float
|
||||||
|
chocosct connect $path
|
||||||
|
hsetprop $path write astchopwrite "ratio 2 "
|
||||||
|
hsetprop $path astchopwritereply astchopwritereply
|
||||||
|
chocosct write $path
|
||||||
|
hsetprop $path checklimits astchopratiolimit
|
||||||
|
hsetprop $path halt astchopstop
|
||||||
|
hsetprop $path checkstatus astchopcheckratio
|
||||||
|
makesctdriveobj $var $path DriveAdapter chocosct
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc chosta {} {
|
||||||
|
global chopperlonglist chopperparlist choppers chopperheader
|
||||||
|
set result "$chopperheader\n"
|
||||||
|
append line [format "%-20s " ""]
|
||||||
|
set count 1
|
||||||
|
foreach ch $choppers {
|
||||||
|
append line [format "%-20s " $ch]
|
||||||
|
incr count
|
||||||
|
}
|
||||||
|
append result $line "\n"
|
||||||
|
set nchop [llength $choppers]
|
||||||
|
set len [llength $chopperlonglist]
|
||||||
|
for {set i 0} {$i < $len} {incr i} {
|
||||||
|
set line ""
|
||||||
|
set par [lindex $chopperlonglist $i]
|
||||||
|
append line [format "%-20s " $par]
|
||||||
|
for {set n 0} {$n < $nchop} {incr n} {
|
||||||
|
set chname [lindex $choppers $n]
|
||||||
|
set parname [lindex $chopperparlist $i]
|
||||||
|
set val [hval /sics/choco/${chname}/${parname}]
|
||||||
|
append line [format "%-20s " $val]
|
||||||
|
}
|
||||||
|
append result $line "\n"
|
||||||
|
}
|
||||||
|
return $result
|
||||||
|
}
|
||||||
|
#======================= Configuration Section ==========================
|
||||||
|
|
||||||
|
if {$amor == 1} {
|
||||||
|
set choppers [list chopper1 chopper2]
|
||||||
|
set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra t_cho \
|
||||||
|
durch vakum valve sumsi spver state]
|
||||||
|
set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \
|
||||||
|
"Loss Current" Ratio Vibration Temperature "Water Flow" Vakuum \
|
||||||
|
Valve Sumsi]
|
||||||
|
set chopperheader "AMOR Chopper Status"
|
||||||
|
makesctcontroller chocosct std ${ts}:3014 "\r\n" 60
|
||||||
|
# makesctcontroller chocosct std localhost:8080 "\r\n" 60
|
||||||
|
chocosct debug -1
|
||||||
|
set maxspeed 5000
|
||||||
|
set minphase 0
|
||||||
|
astriumMakeChopperParameters
|
||||||
|
astMakeChopperSpeed1 chopperspeed
|
||||||
|
astMakeChopperPhase2 chopper2phase
|
||||||
|
Publish chosta Spy
|
||||||
|
}
|
||||||
|
|
||||||
|
#----------------------------- POLDI -----------------------------------------
|
||||||
|
if {$poldi == 1} {
|
||||||
|
|
||||||
|
proc poldiastchopphaselimit {} {
|
||||||
|
set val [sct target]
|
||||||
|
if {$val < 80 || $val > 100} {
|
||||||
|
error "chopper phase out of range"
|
||||||
|
}
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#-------
|
||||||
|
proc poldispeedwrite {} {
|
||||||
|
set val [sct target]
|
||||||
|
set l [split [config myrights] =]
|
||||||
|
set rights [string trim [lindex $l 1]]
|
||||||
|
if {$rights == 2} {
|
||||||
|
if {$val < 4990 || $val > 15000} {
|
||||||
|
clientput "ERROR: Users may only drive the chopper between 5000 - 15000 RPM"
|
||||||
|
hupdate /sics/choco/stop 1
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return [astchopwrite "nspee 1 "]
|
||||||
|
}
|
||||||
|
#-----------
|
||||||
|
set choppers [list chopper]
|
||||||
|
set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra vibax t_cho \
|
||||||
|
flowr vakum valve sumsi spver state]
|
||||||
|
set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \
|
||||||
|
"Loss Current" Ratio Vibration "Actual Vibration" Temperature "Water Flow" Vakuum \
|
||||||
|
Valve Sumsi]
|
||||||
|
set chopperheader "POLDI Chopper Status"
|
||||||
|
makesctcontroller chocosct std lnsts13:3005 "\r\n" 60
|
||||||
|
# makesctcontroller chocosct std localhost:8080 "\r\n" 60
|
||||||
|
chocosct debug -1
|
||||||
|
set maxspeed 15000
|
||||||
|
set minphase 80
|
||||||
|
astriumMakeChopperParameters
|
||||||
|
# astMakeChopperSpeed1 chopperspeed
|
||||||
|
|
||||||
|
set path /sics/choco/chopper/speed
|
||||||
|
hfactory $path plain user float
|
||||||
|
hsetprop $path read astspeedread chopper
|
||||||
|
hsetprop $path write poldispeedwrite
|
||||||
|
hsetprop $path astchopwritereply astchopwritereply
|
||||||
|
chocosct write $path
|
||||||
|
hsetprop $path checklimits astchopspeedlimit 0
|
||||||
|
hsetprop $path halt astchopstop
|
||||||
|
hsetprop $path checkstatus astchopcheckspeed chopper
|
||||||
|
hsetprop $path priv user
|
||||||
|
makesctdriveobj chopperspeed $path DriveAdapter chocosct
|
||||||
|
|
||||||
|
astMakeChopperPhase1 chopperphase
|
||||||
|
hsetprop /sics/choco/chopper/phase checklimit poldiastchopphaselimit
|
||||||
|
Publish chosta Spy
|
||||||
|
}
|
||||||
|
#----------------------------- FOCUS -----------------------------------------------------
|
||||||
|
if {$focus == 1} {
|
||||||
|
set choppers [list fermi disk]
|
||||||
|
set chopperparlist [list state amode aspee nspee nphas dphas averl ratio vibra t_cho \
|
||||||
|
durch vakum valve sumsi]
|
||||||
|
set chopperlonglist [list "Chopper State" "Chopper Mode" "Actual Speed" "Set Speed" \
|
||||||
|
"Phase" "Phase Error" \
|
||||||
|
"Loss Current" Ratio Vibration Temperature "Water Flow" \
|
||||||
|
Vakuum Valve Sumsi]
|
||||||
|
set chopperheader "FOCUS Chopper Status"
|
||||||
|
makesctcontroller chocosct std psts227:3008 "\r\n" 60
|
||||||
|
# makesctcontroller chocosct std localhost:8080 "\r\n" 60
|
||||||
|
chocosct debug -1
|
||||||
|
set maxspeed 20000
|
||||||
|
set minphase 0
|
||||||
|
astriumMakeChopperParameters
|
||||||
|
astMakeChopperSpeed1 fermispeed
|
||||||
|
astMakeChopperSpeed2 diskspeed
|
||||||
|
astMakeChopperRatio ratio
|
||||||
|
astMakeChopperPhase2 phase
|
||||||
|
Publish chosta Spy
|
||||||
|
}
|
||||||
@@ -0,0 +1,32 @@
|
|||||||
|
proc nextBackupTime {now period last} {
|
||||||
|
upvar $last l
|
||||||
|
set l [expr $now / $period * $period]
|
||||||
|
return [expr $l + $period]
|
||||||
|
}
|
||||||
|
|
||||||
|
proc backupCron {path {minutes 10} {days 1}} {
|
||||||
|
global next_backup
|
||||||
|
set now [clock seconds]
|
||||||
|
set minutes [expr $minutes * 60]
|
||||||
|
set days [expr $days * 24*3600]
|
||||||
|
if {! [info exists next_backup]} {
|
||||||
|
set next_backup(min) [nextBackupTime $now $minutes last]
|
||||||
|
set next_backup(day) [nextBackupTime $now $days last]
|
||||||
|
set file [clock format $now -format "$path/backupd-%m-%d.tcl"]
|
||||||
|
if {![file exists $file]} {
|
||||||
|
backup $file
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {$now > $next_backup(min)} {
|
||||||
|
set next_backup(min) [nextBackupTime $now $minutes last]
|
||||||
|
set file [clock format $last -format "$path/backup-%Hh%M.tcl"]
|
||||||
|
} else {
|
||||||
|
return 1
|
||||||
|
}
|
||||||
|
if {$now > $next_backup(day)} {
|
||||||
|
set next_backup(day) [nextBackupTime $now $days last]
|
||||||
|
set file [clock format $last -format "$path/backupd-%m-%d.tcl"]
|
||||||
|
}
|
||||||
|
backup $file
|
||||||
|
return 1
|
||||||
|
}
|
||||||
@@ -0,0 +1,29 @@
|
|||||||
|
#--------------------------------------------
|
||||||
|
# The old batchrun, batchroot pair
|
||||||
|
# Mark Koennecke, since 1996
|
||||||
|
#--------------------------------------------
|
||||||
|
|
||||||
|
if { [info exists batchinit] == 0 } {
|
||||||
|
set batchinit 1
|
||||||
|
Publish batchroot Spy
|
||||||
|
Publish batchrun User
|
||||||
|
}
|
||||||
|
|
||||||
|
proc SplitReply { text } {
|
||||||
|
set l [split $text =]
|
||||||
|
return [lindex $l 1]
|
||||||
|
}
|
||||||
|
#---------------------
|
||||||
|
proc batchrun file {
|
||||||
|
exe [string trim [SplitReply [batchroot]]/$file]
|
||||||
|
}
|
||||||
|
#---------------------
|
||||||
|
proc batchroot args {
|
||||||
|
if {[llength $args] > 1} {
|
||||||
|
exe batchpath [lindex $args 0]
|
||||||
|
return OK
|
||||||
|
} else {
|
||||||
|
set bp [SplitReply [exe batchpath]]
|
||||||
|
return "batchroot = $bp"
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -0,0 +1,169 @@
|
|||||||
|
#------------------------------------------------------
|
||||||
|
# This is SICS HM driver code for the CCDWWW CCD camera
|
||||||
|
# WWW server as used at SINQ. It uses, of course, the
|
||||||
|
# scriptcontext asynchronous I/O system
|
||||||
|
#
|
||||||
|
# Mark Koennecke, September 2010
|
||||||
|
#-------------------------------------------------------
|
||||||
|
|
||||||
|
namespace eval ccdwww {}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
# This is a default init script. The user has to initialise
|
||||||
|
# a list of nodes to send to the CCD in XML format as
|
||||||
|
# variable ccdwww::initnodes
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc ccdwww::initscript {name} {
|
||||||
|
global ccdwww::initnodes
|
||||||
|
|
||||||
|
append confdata "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
|
||||||
|
foreach var $ccdwww::initnodes {
|
||||||
|
set val [hval /sics/${name}/${var}]
|
||||||
|
append confdata "<$var>$val</$var>\n"
|
||||||
|
}
|
||||||
|
return $confdata
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
proc ccdwww::httpsend {url} {
|
||||||
|
sct send $url
|
||||||
|
return httpreply
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
proc ccdwww::httpsendstart {url} {
|
||||||
|
sct send $url
|
||||||
|
return httpstartreply
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc ccdwww::httptest {data} {
|
||||||
|
if {[string first ASCERR $data] >= 0} {
|
||||||
|
error $data
|
||||||
|
}
|
||||||
|
if {[string first ERROR $data] >= 0} {
|
||||||
|
error $data
|
||||||
|
}
|
||||||
|
return $data
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc ccdwww::httpreply {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {httptest $reply} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
clientput $data
|
||||||
|
} else {
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc ccdwww::httpstartreply {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {httptest $reply} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
} else {
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
}
|
||||||
|
clientput $data
|
||||||
|
after 100
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
# A CCD works like a camera. When exposing, it cannot be stopped,
|
||||||
|
# paused or anything. This is why the appropriate methods
|
||||||
|
# here have no implementation
|
||||||
|
#----------------------------------------------------------
|
||||||
|
proc ccdwww::httpcontrol {} {
|
||||||
|
set target [sct target]
|
||||||
|
switch $target {
|
||||||
|
1000 {
|
||||||
|
set path [file dirname [sct]]
|
||||||
|
set preset [hval $path/preset]
|
||||||
|
set ret [ccdwww::httpsendstart "/ccd/expose?time=$preset"]
|
||||||
|
hupdate $path/status run
|
||||||
|
[sct controller] queue $path/status progress read
|
||||||
|
return $ret
|
||||||
|
}
|
||||||
|
1001 {}
|
||||||
|
1002 {}
|
||||||
|
1003 {}
|
||||||
|
1005 {
|
||||||
|
set path [file dirname [sct]]
|
||||||
|
set script [hval $path/initscript]
|
||||||
|
set confdata [eval $script]
|
||||||
|
clientput $confdata
|
||||||
|
return [ccdwww::httpsend "post:/ccd/configure:$confdata"]
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
sct print "ERROR: bad start target $target given to control"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc ccdwww::httpdata {name} {
|
||||||
|
set path "/sics/${name}/data"
|
||||||
|
set com [format "node:%s:/ccd/data" $path]
|
||||||
|
sct send $com
|
||||||
|
return httpdatareply
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc ccdwww::httpdatareply {} {
|
||||||
|
set status [catch {httpreply} txt]
|
||||||
|
if {$status == 0} {
|
||||||
|
set path [file dirname [sct]]
|
||||||
|
hdelprop $path/data geterror
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc ccdwww::httpstatus {} {
|
||||||
|
sct send /ccd/locked
|
||||||
|
return httpevalstatus
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
proc ccdwww::httpstatusdata {} {
|
||||||
|
catch {httpdatareply}
|
||||||
|
sct update idle
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc ccdwww::httpevalstatus {name} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {httptest $reply} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
clientput $data
|
||||||
|
sct update error
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
if {$data == 0} {
|
||||||
|
httpdata $name
|
||||||
|
return httpstatusdata
|
||||||
|
} else {
|
||||||
|
sct update run
|
||||||
|
[sct controller] queue [sct] progress read
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc ccdwww::MakeCCDWWW {name host initscript} {
|
||||||
|
sicsdatafactory new ${name}transfer
|
||||||
|
makesctcontroller ${name}sct sinqhttpopt $host ${name}transfer 600
|
||||||
|
MakeSecHM $name 2
|
||||||
|
hsetprop /sics/${name}/control write ccdwww::httpcontrol
|
||||||
|
hsetprop /sics/${name}/control httpreply ccdwww::httpreply
|
||||||
|
hsetprop /sics/${name}/control httpstartreply ccdwww::httpstartreply
|
||||||
|
${name}sct write /sics/${name}/control
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/data read ccdwww::httpdata $name
|
||||||
|
hsetprop /sics/${name}/data httpdatareply ccdwww::httpdatareply
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/status read ccdwww::httpstatus
|
||||||
|
hsetprop /sics/${name}/status httpevalstatus ccdwww::httpevalstatus $name
|
||||||
|
hsetprop /sics/${name}/status httpstatusdata ccdwww::httpstatusdata
|
||||||
|
${name}sct poll /sics/${name}/status 60
|
||||||
|
|
||||||
|
hfactory /sics/${name}/initscript plain mugger text
|
||||||
|
hset /sics/${name}/initscript $initscript
|
||||||
|
}
|
||||||
@@ -0,0 +1 @@
|
|||||||
|
gdb -d /afs/psi.ch/user/k/koennecke/src/workspace/sics -d /afs/psi.ch/user/k/koennecke/src/workspace/sics/psi SICServer $*
|
||||||
@@ -0,0 +1,357 @@
|
|||||||
|
#---------------------------------------------------------------
|
||||||
|
# These are the scripts for the delta-tau PMAC motor
|
||||||
|
# controller.
|
||||||
|
#
|
||||||
|
# !!!!!!!!! Script Chains !!!!!!!!!!!
|
||||||
|
# -- For reading parameters:
|
||||||
|
# sendpmacread code -- pmacreadreply
|
||||||
|
# -- For setting standard parameters
|
||||||
|
# sendpmacwrite code -- pmacreadreply
|
||||||
|
# -- For reading limits
|
||||||
|
# sendpmaclim -- readpmaclim
|
||||||
|
# -- For reading the status
|
||||||
|
# pmacsendaxer --- pmacrcvaxerr -- pmacrcvpos -- pmacrcvstat
|
||||||
|
# This means we check for an axis error first, then update the position,
|
||||||
|
# then check the axis status itself.
|
||||||
|
# -- For setting the position
|
||||||
|
# pmacsendhardpos -- pmacrcvhardpos -- pmacrcvhardax
|
||||||
|
# This means, we send the positioning command, read the reply and read the
|
||||||
|
# axisstatus until the axis has started
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, December 2008, March 2009
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc translatePMACError {key} {
|
||||||
|
set pmacerr(ERR001) "Command not allowed while executing"
|
||||||
|
set pmacerr(ERR002) "Password error"
|
||||||
|
set pmacerr(ERR003) "Unrecognized command"
|
||||||
|
set pmacerr(ERR004) "Illegal character"
|
||||||
|
set pmacerr(ERR005) "Command not allowed"
|
||||||
|
set pmacerr(ERR006) "No room in buffer for command"
|
||||||
|
set pmacerr(ERR007) "Buffer already in use"
|
||||||
|
set pmacerr(ERR008) "MACRO auxiliary communication error"
|
||||||
|
set pmacerr(ERR009) "Bad program in MCU"
|
||||||
|
set pmacerr(ERR010) "Both HW limits set"
|
||||||
|
set pmacerr(ERR011) "Previous move did not complete"
|
||||||
|
set pmacerr(ERR012) "A motor is open looped"
|
||||||
|
set pmacerr(ERR013) "A motor is not activated"
|
||||||
|
set pmacerr(ERR014) "No motors"
|
||||||
|
set pmacerr(ERR015) "No valid program in MCU"
|
||||||
|
set pmacerr(ERR016) "Bad program in MCU"
|
||||||
|
set pmacerr(ERR017) "Trying to resume after H or Q"
|
||||||
|
set pmacerr(ERR018) "Invalid operation during move"
|
||||||
|
set pmacerr(ERR019) "Illegal position change command during move"
|
||||||
|
return $pmacerr($key)
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc translateAxisError {key} {
|
||||||
|
switch [string trim $key] {
|
||||||
|
0 {return "no error"}
|
||||||
|
1 { return "limit violation"}
|
||||||
|
2 -
|
||||||
|
3 -
|
||||||
|
4 { return "jog error"}
|
||||||
|
5 {return "command not allowed"}
|
||||||
|
6 {return "watchdog triggered"}
|
||||||
|
7 {return "current limit reached"}
|
||||||
|
8 -
|
||||||
|
9 {return "Air cushion error"}
|
||||||
|
10 {return "MCU lim reached"}
|
||||||
|
11 {return "following error triggered"}
|
||||||
|
12 {return "EMERGENCY STOP ACTIVATED"}
|
||||||
|
13 {return "Driver electronics error"}
|
||||||
|
default { return "Unknown axis error $key"}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc evaluateAxisStatus {key} {
|
||||||
|
#----- Tcl does not like negative numbers as keys.
|
||||||
|
if {$key < 0} {
|
||||||
|
set key [expr 50 + abs($key)]
|
||||||
|
}
|
||||||
|
switch $key {
|
||||||
|
0 -
|
||||||
|
14 {return idle}
|
||||||
|
1 -
|
||||||
|
2 -
|
||||||
|
3 -
|
||||||
|
4 -
|
||||||
|
5 -
|
||||||
|
6 -
|
||||||
|
7 -
|
||||||
|
8 -
|
||||||
|
9 -
|
||||||
|
10 -
|
||||||
|
56 -
|
||||||
|
11 {return run}
|
||||||
|
55 {error "Axis is deactivated"}
|
||||||
|
54 {error "emergency stop activated, please release"}
|
||||||
|
53 {error "Axis inhibited"}
|
||||||
|
51 -
|
||||||
|
52 {error "Incoming command is blocked"}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc checkpmacresult {} {
|
||||||
|
set data [sct result]
|
||||||
|
if {[string first ASCERR $data] >= 0} {
|
||||||
|
error $data
|
||||||
|
}
|
||||||
|
if {[string first ERR $data] >= 0} {
|
||||||
|
error [translatePMACError $data]
|
||||||
|
}
|
||||||
|
return [string trim $data]
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc sendpmacread {code} {
|
||||||
|
sct send $code
|
||||||
|
return pmacreadreply
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacreadreply {} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
} else {
|
||||||
|
sct update $data
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc sendpmaclim {code} {
|
||||||
|
sct send $code
|
||||||
|
return pmacreadlim
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc pmacreadlim {motname} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
} else {
|
||||||
|
set scale [hval /sics/${motname}/scale_factor]
|
||||||
|
sct update [expr $data * $scale]
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc sendpmacwrite {code} {
|
||||||
|
set value [sct target]
|
||||||
|
sct send "$code=$value"
|
||||||
|
return pmacwritereply
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacwritereply {} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
sct print "ERROR: $data"
|
||||||
|
} else {
|
||||||
|
set con [sct controller]
|
||||||
|
$con queue [sct] read read
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc configurePMACPar {name par code sct} {
|
||||||
|
set path /sics/$name/$par
|
||||||
|
hsetprop $path read "sendpmacread $code"
|
||||||
|
hsetprop $path pmacreadreply pmacreadreply
|
||||||
|
$sct poll $path 30
|
||||||
|
hsetprop $path write "sendpmacwrite $code"
|
||||||
|
hsetprop $path pmacwritereply pmacwritereply
|
||||||
|
$sct write $path
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc makePMACPar {name par code sct priv} {
|
||||||
|
set path /sics/$name/$par
|
||||||
|
hfactory $path plain $priv float
|
||||||
|
configurePMACPar $name $par $code $sct
|
||||||
|
}
|
||||||
|
#========================== status functions =============================
|
||||||
|
proc pmacsendaxerr {num} {
|
||||||
|
sct send "P${num}01"
|
||||||
|
return rcvaxerr
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacrcvaxerr {motname num} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $motname : $data"
|
||||||
|
sct update error
|
||||||
|
sct geterror $data
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hupdate /sics/$motname/axiserror $data
|
||||||
|
if {$data != 0 } {
|
||||||
|
set err [translateAxisError $data]
|
||||||
|
if {[string first following $err] >= 0} {
|
||||||
|
clientput "WARNING: $motname : $err"
|
||||||
|
sct update poserror
|
||||||
|
} else {
|
||||||
|
clientput "ERROR: $motname : $err"
|
||||||
|
sct update error
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hupdate /sics/$motname/axiserror $data
|
||||||
|
sct send "Q${num}10"
|
||||||
|
return rcvpos
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacrcvpos {motname num} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $motname : $data"
|
||||||
|
sct geterror $data
|
||||||
|
sct update error
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hupdate /sics/$motname/hardposition $data
|
||||||
|
sct send "P${num}00"
|
||||||
|
return rcvstat
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacrcvstat {motname num sct} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $motname : $data"
|
||||||
|
sct update error
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
set status [catch {evaluateAxisStatus $data} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct update error
|
||||||
|
} else {
|
||||||
|
sct update $msg
|
||||||
|
switch $msg {
|
||||||
|
idle {
|
||||||
|
# force an update of the motor position
|
||||||
|
$sct queue /sics/$motname/hardposition progress read
|
||||||
|
}
|
||||||
|
run {
|
||||||
|
# force an update of ourselves, while running
|
||||||
|
$sct queue /sics/$motname/status progress read
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc configurePMACStatus {motname num sct} {
|
||||||
|
set path /sics/$motname/status
|
||||||
|
hsetprop $path read "pmacsendaxerr $num"
|
||||||
|
hsetprop $path rcvaxerr "pmacrcvaxerr $motname $num"
|
||||||
|
hsetprop $path rcvpos "pmacrcvpos $motname $num"
|
||||||
|
hsetprop $path rcvstat "pmacrcvstat $motname $num $sct"
|
||||||
|
$sct poll $path 60
|
||||||
|
}
|
||||||
|
#======================= setting hard position ===========================
|
||||||
|
proc pmacsendhardpos {motname num} {
|
||||||
|
hupdate /sics/$motname/status run
|
||||||
|
set value [sct target]
|
||||||
|
sct send [format "P%2.2d23=0 Q%2.2d01=%12.4f M%2.2d=1" $num $num $value $num]
|
||||||
|
return rcvhardpos
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc pmacrcvhardpos {num} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $data"
|
||||||
|
sct seterror $data
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
sct send "P${num}00"
|
||||||
|
return rcvhardax
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacrcvhardax {motname num sct} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $motname : $data"
|
||||||
|
sct seterror $data
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
set status [catch {evaluateAxisStatus $data} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $motname : $msg"
|
||||||
|
sct seterror $msg
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
switch $msg {
|
||||||
|
idle {
|
||||||
|
sct send "P${num}00"
|
||||||
|
return rcvhardax
|
||||||
|
}
|
||||||
|
run {
|
||||||
|
$sct queue /sics/$motname/status progress read
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc configurePMAChardwrite {motname num sct} {
|
||||||
|
set path /sics/$motname/hardposition
|
||||||
|
hsetprop $path write "pmacsendhardpos $motname $num"
|
||||||
|
hsetprop $path rcvhardpos "pmacrcvhardpos $num"
|
||||||
|
hsetprop $path rcvhardax "pmacrcvhardax $motname $num $sct"
|
||||||
|
}
|
||||||
|
#======================= Halt =============================================
|
||||||
|
proc pmacHalt {sct num} {
|
||||||
|
$sct send "M${num}=8" halt
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#==================== Reference Run =======================================
|
||||||
|
proc pmacrefrun {motorname sct num} {
|
||||||
|
set path /sics/${motorname}/status
|
||||||
|
$sct send "M${num}=9"
|
||||||
|
hupdate /sics/${motorname}/status run
|
||||||
|
set motstat run
|
||||||
|
wait 3
|
||||||
|
while {[string compare $motstat run] == 0} {
|
||||||
|
$sct queue $path progress read
|
||||||
|
wait 1
|
||||||
|
set motstat [string trim [hval $path]]
|
||||||
|
}
|
||||||
|
return "Done"
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
proc MakeDeltaTau {name sct num} {
|
||||||
|
MakeSecMotor $name
|
||||||
|
hsetprop /sics/${name}/hardupperlim read "sendpmaclim I${num}13"
|
||||||
|
hsetprop /sics/${name}/hardupperlim pmacreadlim "pmacreadlim $name"
|
||||||
|
$sct poll /sics/${name}/hardupperlim 180
|
||||||
|
hsetprop /sics/${name}/hardlowerlim read "sendpmaclim I${num}14"
|
||||||
|
hsetprop /sics/${name}/hardlowerlim pmacreadlim "pmacreadlim $name"
|
||||||
|
$sct poll /sics/${name}/hardlowerlim 180
|
||||||
|
|
||||||
|
# configurePMACPar $name hardlowerlim "Q${num}09" $sct
|
||||||
|
# configurePMACPar $name hardupperlim "Q${num}08" $sct
|
||||||
|
|
||||||
|
configurePMACPar $name hardposition "Q${num}10" $sct
|
||||||
|
configurePMAChardwrite $name $num $sct
|
||||||
|
hfactory /sics/$name/numinmcu plain internal int
|
||||||
|
hupdate /sics/$name/numinmcu ${num}
|
||||||
|
makePMACPar $name enable "M${num}14" $sct mugger
|
||||||
|
makePMACPar $name scale_factor "Q${num}00" $sct mugger
|
||||||
|
makePMACPar $name maxspeed "Q${num}03" $sct mugger
|
||||||
|
makePMACPar $name commandspeed "Q${num}04" $sct mugger
|
||||||
|
makePMACPar $name maxaccel "Q${num}05" $sct mugger
|
||||||
|
makePMACPar $name commandedaccel "Q${num}06" $sct mugger
|
||||||
|
makePMACPar $name offset "Q${num}07" $sct mugger
|
||||||
|
makePMACPar $name axisstatus "P${num}00" $sct internal
|
||||||
|
makePMACPar $name axiserror "P${num}01" $sct internal
|
||||||
|
makePMACPar $name poshwlimitactive "M${num}21" $sct internal
|
||||||
|
makePMACPar $name neghwlimitactive "M${num}22" $sct internal
|
||||||
|
makePMACPar $name liftaircushion "M${num}96" $sct internal
|
||||||
|
configurePMACStatus $name $num $sct
|
||||||
|
$name makescriptfunc halt "pmacHalt $sct $num" user
|
||||||
|
$name makescriptfunc refrun "pmacrefrun $name $sct $num" user
|
||||||
|
set parlist [list scale_factor hardposition maxspeed \
|
||||||
|
commandspeed maxaccel offset axisstatus axiserror status poshwlimitactive \
|
||||||
|
neghwlimitactive liftaircushion hardlowerlim hardupperlim]
|
||||||
|
# $sct send [format "M%2.2d14=1" $num]
|
||||||
|
foreach par $parlist {
|
||||||
|
$sct queue /sics/$name/$par progress read
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -0,0 +1,488 @@
|
|||||||
|
#--------------------------------------------------------
|
||||||
|
# This is a scriptcontext based driver for the EL734
|
||||||
|
# motor controller. This is part of an ongoing effort to
|
||||||
|
# expire older drivers and to consolidate on the new
|
||||||
|
# scriptcontext system.
|
||||||
|
#
|
||||||
|
# Scriptchains:
|
||||||
|
# Rather then having long script chains many of the
|
||||||
|
# intricacies of the EL734 are handled via a command
|
||||||
|
# processing state machine. See the docs below for
|
||||||
|
# details
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, February 2011
|
||||||
|
#--------------------------------------------------------
|
||||||
|
|
||||||
|
namespace eval el734 {}
|
||||||
|
|
||||||
|
#---------------------------------------------------------
|
||||||
|
# The EL734 is a a tricky thing. Some special conditions
|
||||||
|
# apply:
|
||||||
|
# - On emergency stop an *ES is sent. But only the second
|
||||||
|
# response of this kind is valid because there can be
|
||||||
|
# spurious *ES on the line even when the emergency stop
|
||||||
|
# has been released.
|
||||||
|
# - If someone fingers the EL734 or after startup it is in
|
||||||
|
# local mode. Then two commands have to be sent in order to
|
||||||
|
# make it go into remote mode before retrying the command.
|
||||||
|
# - In some echo modes of the controller it sends a echo
|
||||||
|
# of the command. This has to be ignored in order to get at
|
||||||
|
# the real problem
|
||||||
|
#
|
||||||
|
# In order to deal with all this, el734::command is implemented
|
||||||
|
# as a state machine which calls another script when a valid
|
||||||
|
# reponse has actually been found.
|
||||||
|
# The state of the current command processing
|
||||||
|
# is saved in a node property comstate. The actual command to send
|
||||||
|
# is in the property comstring. The script to call if we actually
|
||||||
|
# have a valid response is stored in the property comresponse
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc el734::setcommand {command responsescript {motno 0}} {
|
||||||
|
sct comresponse $responsescript
|
||||||
|
sct comstate start
|
||||||
|
sct comstring $command
|
||||||
|
sct commotno $motno
|
||||||
|
return command
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
# As implemented now this can go in an endless loop if switching
|
||||||
|
# to local fails repeatedly. TODO: test if this happens with the
|
||||||
|
# real device
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc el734::command {} {
|
||||||
|
set state [sct comstate]
|
||||||
|
switch $state {
|
||||||
|
start {
|
||||||
|
set com [sct comstring]
|
||||||
|
sct send $com
|
||||||
|
sct comstate waitresponse
|
||||||
|
}
|
||||||
|
waitstart {
|
||||||
|
wait 1
|
||||||
|
sct comstate start
|
||||||
|
return [el734::command]
|
||||||
|
}
|
||||||
|
waitresponse {
|
||||||
|
set reply [sct result]
|
||||||
|
if {[string first "*ES" $reply] >= 0} {
|
||||||
|
set com [sct comstring]
|
||||||
|
sct send $com
|
||||||
|
sct comstate waitES
|
||||||
|
return command
|
||||||
|
}
|
||||||
|
if {[string first "?LOC" $reply] >= 0} {
|
||||||
|
sct send "RMT 1"
|
||||||
|
sct comstate waitrmt
|
||||||
|
return command
|
||||||
|
}
|
||||||
|
if {[string first "?BSY" $reply] >= 0} {
|
||||||
|
set mot [sct commotno]
|
||||||
|
if {$mot != 0} {
|
||||||
|
set com [format "S %d" $mot]
|
||||||
|
} else {
|
||||||
|
set com "S"
|
||||||
|
}
|
||||||
|
sct send $com
|
||||||
|
sct comstate waitstart
|
||||||
|
return command
|
||||||
|
}
|
||||||
|
set com [sct comstring]
|
||||||
|
set idx [string first $com $reply]
|
||||||
|
if {[string first $com $reply] >= 0} {
|
||||||
|
sct send @@NOSEND@@
|
||||||
|
sct comstate waitresponse
|
||||||
|
return command
|
||||||
|
}
|
||||||
|
set responsescript [sct comresponse]
|
||||||
|
return [eval $responsescript]
|
||||||
|
}
|
||||||
|
waitES {
|
||||||
|
set reply [sct result]
|
||||||
|
if {[string first "*ES" $reply] >= 0} {
|
||||||
|
clientput "Emergency STOP ENGAGED, release to continue"
|
||||||
|
error "Emergency Stop ENGAGED"
|
||||||
|
}
|
||||||
|
set responsescript [sct comresponse]
|
||||||
|
return [eval $responsescript]
|
||||||
|
}
|
||||||
|
waitrmt {
|
||||||
|
sct send "ECHO 0"
|
||||||
|
sct comstate start
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return command
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::checkerror {} {
|
||||||
|
set err(?ADR) "Bad address"
|
||||||
|
set err(?CMD) "Bad command"
|
||||||
|
set err(?PAR) "Bad parameter"
|
||||||
|
set err(?RNG) "Parameter out of range"
|
||||||
|
set err(?BSY) "Motor busy"
|
||||||
|
set err(*MS) "Bad step"
|
||||||
|
set err(*ES) "Emergency stop engaged"
|
||||||
|
|
||||||
|
set reply [string trim [sct result]]
|
||||||
|
set errlist [array names err]
|
||||||
|
foreach entry $errlist {
|
||||||
|
if {[string first $entry $reply] >= 0} {
|
||||||
|
error $err($entry)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $reply
|
||||||
|
}
|
||||||
|
#========================== Position ===============================
|
||||||
|
proc el734::readpos {num} {
|
||||||
|
set com [format "u %d" $num]
|
||||||
|
return [el734::setcommand $com el734::posresponse]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::posresponse {} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
sct update $reply
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::setpos {name num} {
|
||||||
|
set newpos [sct target]
|
||||||
|
set com [format "p %d %f" $num $newpos]
|
||||||
|
hupdate /sics/${name}/status run
|
||||||
|
hupdate /sics/${name}/oredmsr 3
|
||||||
|
hupdate /sics/${name}/runfault 0
|
||||||
|
hupdate /sics/${name}/posfault 0
|
||||||
|
return [el734::setcommand $com "el734::setposresponse $name"]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::setposresponse {name} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
[sct controller] queue /sics/${name}/status progress read
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#===================== Limits =====================================
|
||||||
|
proc el734::getlim {name num} {
|
||||||
|
set com [format "H %d" $num]
|
||||||
|
return [el734::setcommand $com "el734::limresponse $name"]
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------
|
||||||
|
proc el734::limresponse {name} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
stscan $reply "%f %f" low high
|
||||||
|
hupdate /sics/${name}/hardlowerlim $low
|
||||||
|
hupdate /sics/${name}/hardupperlim $high
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc el734::setlim {controller name num low high} {
|
||||||
|
set com [format "H %d %f %f" $num $low $high]
|
||||||
|
$controller send $com
|
||||||
|
$controller queue /sics/${name}/hardlowerlim progress read
|
||||||
|
wait 1
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#======================== status ================================
|
||||||
|
proc el734::decodemsr {name msr} {
|
||||||
|
set oredata(0x02) idle:none
|
||||||
|
set oredata(0x10) error:lowlim
|
||||||
|
set oredata(0x20) error:hilim
|
||||||
|
set oredata(0x80) posfault:runfault
|
||||||
|
set oredata(0x200) posfault:posfault
|
||||||
|
set oredata(0x1000) "error:air cushion"
|
||||||
|
set oredata(0x40) "error:bad step"
|
||||||
|
set oredata(0x100) error:positionfault
|
||||||
|
set oredata(0x400) error:positionfault
|
||||||
|
|
||||||
|
set msrdata(0x20) hilim
|
||||||
|
set msrdata(0x10) lowlim
|
||||||
|
set msrdata(0x1000) "air cushion"
|
||||||
|
set msrdata(0x40) "Bad step"
|
||||||
|
set msrdata(0x100) posfault
|
||||||
|
set msrdata(0x400) posfault
|
||||||
|
|
||||||
|
set oredmsr [hval /sics/${name}/oredmsr]
|
||||||
|
if {$msr == 0} {
|
||||||
|
#-------- FINISHED
|
||||||
|
set pos [hval /sics/${name}/posfault]
|
||||||
|
set run [hval /sics/${name}/runfault]
|
||||||
|
if {$pos > 0 || $run > 0} {
|
||||||
|
return posfault
|
||||||
|
}
|
||||||
|
|
||||||
|
set orlist [array names oredata]
|
||||||
|
foreach code $orlist {
|
||||||
|
if {$oredmsr & $code} {
|
||||||
|
set l [split $oredata($code) :]
|
||||||
|
set txt [lindex $l 1]
|
||||||
|
set ret [lindex $l 0]
|
||||||
|
hupdate /sics/${name}/lasterror $txt
|
||||||
|
if {[string compare $ret error] == 0} {
|
||||||
|
clientput "ERROR: $txt on motor $name"
|
||||||
|
}
|
||||||
|
return $ret
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {$oredmsr == 0} {
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
#------------ Still Running.........
|
||||||
|
set msrlist [array names msrdata]
|
||||||
|
foreach code $msrlist {
|
||||||
|
if {$msr & $code} {
|
||||||
|
clientput "ERROR: $msrdata($code) on motor $name"
|
||||||
|
return error
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {$msr & 0x80} {
|
||||||
|
set val [hval /sics/${name}/runfault]
|
||||||
|
incr val
|
||||||
|
hupdate /sics/${name}/runfault $val
|
||||||
|
}
|
||||||
|
if {$msr & 0x200} {
|
||||||
|
set val [hval /sics/${name}/posfault]
|
||||||
|
incr val
|
||||||
|
hupdate /sics/${name}/posfault $val
|
||||||
|
}
|
||||||
|
|
||||||
|
hupdate /sics/${name}/oredmsr [expr $oredmsr | $msr]
|
||||||
|
return run
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc el734::readstatus {num name} {
|
||||||
|
set com [format "msr %d" $num]
|
||||||
|
return [el734::setcommand $com "el734::statresponse $name $num"]
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc el734::statresponse {name num} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
stscan $reply "%d" msr
|
||||||
|
set status [el734::decodemsr $name $msr]
|
||||||
|
sct update $status
|
||||||
|
switch $status {
|
||||||
|
run {
|
||||||
|
set con [sct controller]
|
||||||
|
$con queue /sics/${name}/hardposition progress read
|
||||||
|
$con queue /sics/${name}/status progress read
|
||||||
|
}
|
||||||
|
idle {
|
||||||
|
set com [format "u %d" $num]
|
||||||
|
return [el734::setcommand $com "el734::posstat $name" ]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc el734::posstat {name} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
hupdate /sics/${name}/hardposition $reply
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#========================== Halt =================================
|
||||||
|
proc el734::halt {controller no} {
|
||||||
|
set com [format "S %d" $no]
|
||||||
|
$controller send $com
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#========================= Speed ================================
|
||||||
|
proc el734::readspeed {num} {
|
||||||
|
set com [format "J %d" $num]
|
||||||
|
return [el734::setcommand $com el734::speedresponse]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::speedresponse {} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
sct update $reply
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::setspeed {name num} {
|
||||||
|
set newpos [sct target]
|
||||||
|
set com [format "J %d %d" $num $newpos]
|
||||||
|
return [el734::setcommand $com "el734::setspeedresponse $name $num"]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::setspeedresponse {name num} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
return [el734::readspeed $num]
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#========================= refnull ================================
|
||||||
|
proc el734::readref {num} {
|
||||||
|
set com [format "V %d" $num]
|
||||||
|
return [el734::setcommand $com el734::refresponse]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::refresponse {} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
sct update $reply
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::setref {name num} {
|
||||||
|
set newpos [sct target]
|
||||||
|
set com [format "V %d %d" $num $newpos]
|
||||||
|
return [el734::setcommand $com "el734::setrefresponse $name $num"]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc el734::setrefresponse {name num} {
|
||||||
|
set stat [catch {checkerror} reply]
|
||||||
|
if {$stat == 0} {
|
||||||
|
return [el734::readref $num]
|
||||||
|
} else {
|
||||||
|
clientput $reply
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#============================= SS =================================
|
||||||
|
proc el734::readss {num} {
|
||||||
|
set com [format "SS %d" $num]
|
||||||
|
sct send $com
|
||||||
|
return ssread
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------
|
||||||
|
proc el734::ssread {} {
|
||||||
|
sct update [sct result]
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#======================== setpos ================================
|
||||||
|
proc el734::forcepos {controller name num newpos} {
|
||||||
|
set com [format "U %d %f" $num $newpos]
|
||||||
|
$controller send $com
|
||||||
|
$controller queue /sics/${name}/hardposition progress read
|
||||||
|
wait 1
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#======================= refrun ==================================
|
||||||
|
proc el734::refrun {controller name num} {
|
||||||
|
clientput "Starting reference run"
|
||||||
|
$controller send [format "R %d" $num]
|
||||||
|
$controller queue /sics/${name}/ss progress read
|
||||||
|
while {1} {
|
||||||
|
wait 2
|
||||||
|
set ss [hval /sics/${name}/ss]
|
||||||
|
if { [string first ?BSY $ss] < 0} {
|
||||||
|
break
|
||||||
|
}
|
||||||
|
set rupt [getint]
|
||||||
|
if { [string compare $rupt continue] != 0} {
|
||||||
|
error "Refererence run interrupted"
|
||||||
|
}
|
||||||
|
$controller queue /sics/${name}/ss progress read
|
||||||
|
}
|
||||||
|
$controller queue /sics/${name}/hardposition progress read
|
||||||
|
wait 2
|
||||||
|
return "Reference run Finished"
|
||||||
|
}
|
||||||
|
#================================================================
|
||||||
|
proc el734::reset {name} {
|
||||||
|
set x [hval /sics/${name}/hardlowerlim]
|
||||||
|
hupdate /sics/${name}/softlowerlim $x
|
||||||
|
set x [hval /sics/${name}/hardupperlim]
|
||||||
|
hupdate /sics/${name}/softupperlim $x
|
||||||
|
hupdate /sics/${name}/softzero 0
|
||||||
|
hupdate /sics/${name}/fixed -1
|
||||||
|
}
|
||||||
|
#========================= Make ==================================
|
||||||
|
proc el734::make {name no controller} {
|
||||||
|
MakeSecMotor $name
|
||||||
|
|
||||||
|
hfactory /sics/${name}/oredmsr plain internal int
|
||||||
|
hfactory /sics/${name}/runfault plain internal int
|
||||||
|
hfactory /sics/${name}/posfault plain internal int
|
||||||
|
hfactory /sics/${name}/lasterror plain internal text
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/hardposition read el734::readpos $no
|
||||||
|
hsetprop /sics/${name}/hardposition command el734::command
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/hardposition write el734::setpos $name $no
|
||||||
|
hsetprop /sics/${name}/hardposition command el734::command
|
||||||
|
$controller write /sics/${name}/hardposition
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/hardlowerlim read el734::getlim $name $no
|
||||||
|
hsetprop /sics/${name}/hardlowerlim command el734::command
|
||||||
|
$controller poll /sics/${name}/hardlowerlim 120
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/status read el734::readstatus $no $name
|
||||||
|
hsetprop /sics/${name}/status command el734::command
|
||||||
|
$controller poll /sics/${name}/status 40
|
||||||
|
|
||||||
|
hfactory /sics/${name}/speed plain user int
|
||||||
|
hsetprop /sics/${name}/speed read el734::readspeed $no
|
||||||
|
hsetprop /sics/${name}/speed command el734::command
|
||||||
|
$controller poll /sics/${name}/speed 120
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/speed write el734::setspeed $name $no
|
||||||
|
hsetprop /sics/${name}/speed command el734::command
|
||||||
|
$controller write /sics/${name}/speed
|
||||||
|
|
||||||
|
$name makescriptfunc halt "el734::halt $controller $no" user
|
||||||
|
$name makescriptfunc reset "el734::reset $name" user
|
||||||
|
|
||||||
|
$name makescriptfunc sethardlim "el734::setlim $controller $name $no" mugger
|
||||||
|
hfactory /sics/${name}/sethardlim/low plain mugger float
|
||||||
|
hfactory /sics/${name}/sethardlim/high plain mugger float
|
||||||
|
|
||||||
|
hfactory /sics/${name}/motno plain internal int
|
||||||
|
hupdate /sics/${name}/motno $no
|
||||||
|
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------------
|
||||||
|
proc el734::addrefstuff {name no controller} {
|
||||||
|
hfactory /sics/${name}/refnull plain user int
|
||||||
|
hsetprop /sics/${name}/refnull read el734::readref $no
|
||||||
|
hsetprop /sics/${name}/refnull command el734::command
|
||||||
|
$controller poll /sics/${name}/refnull 300
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/refnull write el734::setref $name $no
|
||||||
|
hsetprop /sics/${name}/refnull command el734::command
|
||||||
|
$controller write /sics/${name}/refnull
|
||||||
|
|
||||||
|
hfactory /sics/${name}/ss plain internal text
|
||||||
|
hsetprop /sics/${name}/ss read el734::readss $no
|
||||||
|
hsetprop /sics/${name}/ss ssread el734::ssread
|
||||||
|
$controller poll /sics/${name}/ss 300
|
||||||
|
|
||||||
|
$name makescriptfunc refrun "el734::refrun $controller $name $no" user
|
||||||
|
|
||||||
|
}
|
||||||
@@ -0,0 +1,321 @@
|
|||||||
|
#-----------------------------------------------------
|
||||||
|
# This is a second generation counter driver for
|
||||||
|
# the PSI EL737 counter boxes using scriptcontext
|
||||||
|
# communication.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Scriptchains:
|
||||||
|
# start: el737sendstart - el737cmdreply
|
||||||
|
# pause,cont, stop: el737sendcmd - el737cmdreply
|
||||||
|
# status: el737readstatus - el737status
|
||||||
|
# \ el737statval - el737statread
|
||||||
|
# values: el737readvalues - el737val
|
||||||
|
# threshold write: el737threshsend - el737threshrcv - el737cmdreply
|
||||||
|
#
|
||||||
|
# Mark Koennecke, February 2009
|
||||||
|
#-----------------------------------------------------
|
||||||
|
proc el737error {reply} {
|
||||||
|
if {[string first ERR $reply] >= 0} {
|
||||||
|
error $reply
|
||||||
|
}
|
||||||
|
if {[string first ? $reply] < 0} {
|
||||||
|
return ok
|
||||||
|
}
|
||||||
|
if {[string first "?OV" $reply] >= 0} {
|
||||||
|
error overflow
|
||||||
|
}
|
||||||
|
if {[string first "?1" $reply] >= 0} {
|
||||||
|
error "out of range"
|
||||||
|
}
|
||||||
|
if {[string first "?2" $reply] >= 0} {
|
||||||
|
error "bad command"
|
||||||
|
}
|
||||||
|
if {[string first "?3" $reply] >= 0} {
|
||||||
|
error "bad parameter"
|
||||||
|
}
|
||||||
|
if {[string first "?4" $reply] >= 0} {
|
||||||
|
error "bad counter"
|
||||||
|
}
|
||||||
|
if {[string first "?5" $reply] >= 0} {
|
||||||
|
error "parameter missing"
|
||||||
|
}
|
||||||
|
if {[string first "?6" $reply] >= 0} {
|
||||||
|
error "to many counts"
|
||||||
|
}
|
||||||
|
return ok
|
||||||
|
}
|
||||||
|
#---------------------------------------------------
|
||||||
|
proc el737cmdreply {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {el737error $reply} err]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $err
|
||||||
|
set data [sct send]
|
||||||
|
if {[string first overflow $err] >= 0} {
|
||||||
|
clientput "WARNING: trying to fix $err on command = $data"
|
||||||
|
sct send $data
|
||||||
|
return el737cmdreply
|
||||||
|
} else {
|
||||||
|
clientput "ERROR: $err, command = $data"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------
|
||||||
|
proc sctroot {} {
|
||||||
|
set path [sct]
|
||||||
|
return [file dirname $path]
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc el737sendstart {} {
|
||||||
|
set obj [sctroot]
|
||||||
|
set mode [string tolower [string trim [hval $obj/mode]]]
|
||||||
|
set preset [string trim [hval $obj/preset]]
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
switch $mode {
|
||||||
|
timer {
|
||||||
|
set cmd [format "TP %.2f" $preset]
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
set cmd [format "MP %d" [expr int($preset)]]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
sct send $cmd
|
||||||
|
set con [sct controller]
|
||||||
|
$con queue $obj/status progress read
|
||||||
|
catch {hupdate $obj/status run}
|
||||||
|
catch {hupdate $obj/values 0 0 0 0 0 0 0 0}
|
||||||
|
return el737cmdreply
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc el737sendcmd {cmd} {
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
sct send $cmd
|
||||||
|
return el737cmdreply
|
||||||
|
}
|
||||||
|
#---------------------------------------------------
|
||||||
|
proc el737control {} {
|
||||||
|
set target [sct target]
|
||||||
|
switch $target {
|
||||||
|
1000 {return [el737sendstart] }
|
||||||
|
1001 {return [el737sendcmd S] }
|
||||||
|
1002 {return [el737sendcmd PS] }
|
||||||
|
1003 {return [el737sendcmd CO] }
|
||||||
|
default {
|
||||||
|
sct print "ERROR: bad start target $target given to control"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc el737readstatus {} {
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
sct send RS
|
||||||
|
return el737status
|
||||||
|
}
|
||||||
|
#-------------------------------------------------
|
||||||
|
proc el737statval {} {
|
||||||
|
el737readvalues
|
||||||
|
return el737statread
|
||||||
|
}
|
||||||
|
#-------------------------------------------------
|
||||||
|
proc el737statread {} {
|
||||||
|
el737val
|
||||||
|
sct update idle
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#--------------------------------------------------
|
||||||
|
proc el737status {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {el737error $reply} err]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $err
|
||||||
|
sct update error
|
||||||
|
sct print "ERROR: $err"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
set path [sct]
|
||||||
|
set con [sct controller]
|
||||||
|
hupdate [sctroot]/RS $reply
|
||||||
|
switch [string trim $reply] {
|
||||||
|
0 {
|
||||||
|
return el737statval
|
||||||
|
}
|
||||||
|
1 -
|
||||||
|
2 {
|
||||||
|
sct update run
|
||||||
|
$con queue $path progress read
|
||||||
|
}
|
||||||
|
5 -
|
||||||
|
6 {
|
||||||
|
sct update nobeam
|
||||||
|
$con queue $path progress read
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
sct update pause
|
||||||
|
$con queue $path progress read
|
||||||
|
}
|
||||||
|
}
|
||||||
|
set count [sct moncount]
|
||||||
|
if {$count >= 10} {
|
||||||
|
set root [sctroot]
|
||||||
|
$con queue $root/values progress read
|
||||||
|
sct moncount 0
|
||||||
|
} else {
|
||||||
|
incr count
|
||||||
|
sct moncount $count
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#------------------------------------------------
|
||||||
|
proc el737readvalues {} {
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
sct send RA
|
||||||
|
return el737val
|
||||||
|
}
|
||||||
|
#--------------------------------------------------
|
||||||
|
proc swapFirst {l} {
|
||||||
|
set m1 [lindex $l 0]
|
||||||
|
set cts [lindex $l 1]
|
||||||
|
lappend res $cts $m1
|
||||||
|
for {set i 2} {$i < [llength $l]} {incr i} {
|
||||||
|
lappend res [lindex $l $i]
|
||||||
|
}
|
||||||
|
return $res
|
||||||
|
}
|
||||||
|
#---------------------------------------------------
|
||||||
|
# There are two types of reponses to the RA command:
|
||||||
|
# the old form with 5 values and the new one
|
||||||
|
# with 9 values
|
||||||
|
#---------------------------------------------------
|
||||||
|
proc el737val {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {el737error $reply} err]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $err
|
||||||
|
sct print "ERROR: $err"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hupdate [sctroot]/RA $reply
|
||||||
|
set l [split $reply]
|
||||||
|
set root [sctroot]
|
||||||
|
if {[llength $l] > 5} {
|
||||||
|
set l2 [lrange $l 1 end]
|
||||||
|
set l2 [swapFirst $l2]
|
||||||
|
catch {hupdate ${root}/values [join $l2]}
|
||||||
|
catch {set time [lindex $l 0]}
|
||||||
|
catch {hupdate ${root}/time $time}
|
||||||
|
} else {
|
||||||
|
set last [expr [llength $l] - 1]
|
||||||
|
set l2 [lrange $l 0 $last]
|
||||||
|
set l2 [swapFirst $l2]
|
||||||
|
hupdate ${root}/values [join $l2]
|
||||||
|
set time [lindex $l $last]
|
||||||
|
hupdate ${root}/time $time
|
||||||
|
}
|
||||||
|
set mode [hval ${root}/mode]
|
||||||
|
switch $mode {
|
||||||
|
timer {
|
||||||
|
hupdate ${root}/control $time
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
set mon [lindex $l2 1]
|
||||||
|
hupdate ${root}/control $time
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#----------------------------------------------
|
||||||
|
proc el737threshsend {} {
|
||||||
|
set val [string trim [sct target]]
|
||||||
|
set root [sctroot]
|
||||||
|
set cter [string trim [hval $root/thresholdcounter]]
|
||||||
|
sct send [format "DL %1.1d %f" $cter $val]
|
||||||
|
return el737threshrecv
|
||||||
|
}
|
||||||
|
#---------------------------------------------
|
||||||
|
proc el737threshrecv {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {el737error $reply} err]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $err
|
||||||
|
sct print "ERROR: $err"
|
||||||
|
}
|
||||||
|
set root [sctroot]
|
||||||
|
set cter [string trim [hval $root/thresholdcounter]]
|
||||||
|
sct send [format "DR %1.1d" $cter]
|
||||||
|
set sctcon [sct controller]
|
||||||
|
$sctcon queue [sct] progress read
|
||||||
|
return el737cmdreply
|
||||||
|
}
|
||||||
|
#---------------------------------------------
|
||||||
|
proc el737threshread {} {
|
||||||
|
set root [sctroot]
|
||||||
|
set cter [string trim [hval $root/thresholdcounter]]
|
||||||
|
sct send [format "DL %1.1d" $cter]
|
||||||
|
return el737thresh
|
||||||
|
}
|
||||||
|
#----------------------------------------------
|
||||||
|
proc el737thresh {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {el737error $reply} err]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $err
|
||||||
|
sct print "ERROR: $err"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
stscan $reply "%f" val
|
||||||
|
sct update $val
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#----------------------------------------------
|
||||||
|
proc el737func {controller path} {
|
||||||
|
$controller queue $path write
|
||||||
|
}
|
||||||
|
#============================================
|
||||||
|
proc MakeSecEL737 {name netaddr} {
|
||||||
|
MakeSecCounter $name 8
|
||||||
|
set conname ${name}sct
|
||||||
|
makesctcontroller $conname std $netaddr "\r" 10
|
||||||
|
$conname send "RMT 1"
|
||||||
|
$conname send "RMT 1"
|
||||||
|
$conname send "ECHO 2"
|
||||||
|
|
||||||
|
set path /sics/${name}/values
|
||||||
|
hsetprop $path read el737readvalues
|
||||||
|
hsetprop $path el737val el737val
|
||||||
|
$conname poll $path 60
|
||||||
|
|
||||||
|
set path /sics/${name}/status
|
||||||
|
hsetprop $path read el737readstatus
|
||||||
|
hsetprop $path el737status el737status
|
||||||
|
hsetprop $path el737statval el737statval
|
||||||
|
hsetprop $path el737statread el737statread
|
||||||
|
hsetprop $path moncount 0
|
||||||
|
$conname poll $path 60
|
||||||
|
|
||||||
|
set path /sics/${name}/control
|
||||||
|
hsetprop $path write el737control
|
||||||
|
hsetprop $path el737cmdreply el737cmdreply
|
||||||
|
$conname write $path
|
||||||
|
|
||||||
|
hfactory /sics/${name}/thresholdcounter plain mugger int
|
||||||
|
hsetprop /sics/${name}/thresholdcounter __save true
|
||||||
|
set path /sics/${name}/threshold
|
||||||
|
hfactory $path plain mugger float
|
||||||
|
hsetprop $path write el737threshsend
|
||||||
|
hsetprop $path el737threshrcv el737threshrcv
|
||||||
|
hsetprop $path el737cmdreply el737cmdreply
|
||||||
|
$conname write $path
|
||||||
|
hsetprop $path read el737threshread
|
||||||
|
hsetprop $path el737thresh el737thresh
|
||||||
|
# $conname poll $path 60
|
||||||
|
|
||||||
|
hfactory /sics/${name}/RS plain internal int
|
||||||
|
hfactory /sics/${name}/RA plain internal intvarar 8
|
||||||
|
|
||||||
|
$conname debug -1
|
||||||
|
|
||||||
|
}
|
||||||
@@ -0,0 +1,97 @@
|
|||||||
|
#-------------------------------------------------------------
|
||||||
|
# This is a scriptcontext driver for the PSI EL755 magnet
|
||||||
|
# controller.
|
||||||
|
#
|
||||||
|
# scriptchains:
|
||||||
|
# read - readreply
|
||||||
|
# write - writereply - writereadback
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2009
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
|
||||||
|
namespace eval el755 {}
|
||||||
|
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc el755::read {num} {
|
||||||
|
sct send [format "I %d" $num]
|
||||||
|
return readreply
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc el755::readreply {num} {
|
||||||
|
set reply [sct result]
|
||||||
|
if {[string first ? $reply] >= 0} {
|
||||||
|
if {[string first ?OV $reply] >= 0} {
|
||||||
|
sct send [format "I %d" $num]
|
||||||
|
# clientput "EL755 did an overflow...."
|
||||||
|
return readreply
|
||||||
|
}
|
||||||
|
error $reply
|
||||||
|
}
|
||||||
|
set n [stscan $reply "%f %f" soll ist]
|
||||||
|
if {$n < 2} {
|
||||||
|
sct send [format "I %d" $num]
|
||||||
|
clientput "Invalid response $reply from EL755"
|
||||||
|
return readreply
|
||||||
|
}
|
||||||
|
sct update $ist
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc el755::write {num} {
|
||||||
|
set cur [sct target]
|
||||||
|
sct send [format "I %d %f" $num $cur]
|
||||||
|
return writereply
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc el755::writereply {num} {
|
||||||
|
set reply [sct result]
|
||||||
|
if {[string first ? $reply] >= 0} {
|
||||||
|
if {[string first ?OV $reply] >= 0} {
|
||||||
|
set cur [sct target]
|
||||||
|
sct send [format "I %d %f" $num $cur]
|
||||||
|
# clientput "EL755 did an overflow...."
|
||||||
|
return writereply
|
||||||
|
}
|
||||||
|
error $reply
|
||||||
|
}
|
||||||
|
sct send [format "I %d" $num]
|
||||||
|
return writereadback
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc el755::writereadback {num} {
|
||||||
|
set reply [sct result]
|
||||||
|
if {[string first ? $reply] >= 0} {
|
||||||
|
if {[string first ?OV $reply] >= 0} {
|
||||||
|
set cur [sct target]
|
||||||
|
sct send [format "I %d" $num]
|
||||||
|
# clientput "EL755 did an overflow...."
|
||||||
|
return writereadback
|
||||||
|
}
|
||||||
|
error $reply
|
||||||
|
}
|
||||||
|
set n [stscan $reply "%f %f" soll ist]
|
||||||
|
if {$n < 2} {
|
||||||
|
sct send [format "I %d" $num]
|
||||||
|
clientput "Invalid response $reply from EL755"
|
||||||
|
return writereadback
|
||||||
|
}
|
||||||
|
set cur [sct target]
|
||||||
|
if {abs($cur - $soll) < .1} {
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
return el755::write $num
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc el755::makeel755 {name num sct} {
|
||||||
|
stddrive::makestddrive $name EL755Magnet $sct
|
||||||
|
set path /sics/${name}
|
||||||
|
hsetprop $path read el755::read $num
|
||||||
|
hsetprop $path readreply el755::readreply $num
|
||||||
|
hsetprop $path write el755::write $num
|
||||||
|
hsetprop $path writereply el755::writereply $num
|
||||||
|
hsetprop $path writereadback el755::writereadback $num
|
||||||
|
$sct poll $path 60
|
||||||
|
$sct write $path
|
||||||
|
}
|
||||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,944 @@
|
|||||||
|
#-----------------------------------------------------------------------
|
||||||
|
# This is a collection of utility procedures to help with Hipadaba and
|
||||||
|
# Gumtree Swiss Edition. This file is supposed to be sourced by any
|
||||||
|
# instrument using Hipadaba.
|
||||||
|
#
|
||||||
|
# Copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Collected from various files: Mark Koennecke, March 2008
|
||||||
|
#
|
||||||
|
# Requirements:
|
||||||
|
# * the internal scan command xxxscan
|
||||||
|
# * scan data to live /graphics/scan_data
|
||||||
|
#
|
||||||
|
# Many updates, till November 2008, Mark Koennecke
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
if { [info exists hdbinit] == 0 } {
|
||||||
|
set hdbinit 1
|
||||||
|
MakeStateMon
|
||||||
|
Publish getgumtreexml Spy
|
||||||
|
if {[string first tmp $home] < 0} {
|
||||||
|
set tmppath $home/tmp
|
||||||
|
} else {
|
||||||
|
set tmppath $home
|
||||||
|
}
|
||||||
|
Publish mgbatch Spy
|
||||||
|
Publish loadmgbatch Spy
|
||||||
|
Publish hsearchprop Spy
|
||||||
|
Publish hdbscan User
|
||||||
|
Publish hdbprepare User
|
||||||
|
Publish hdbcollect User
|
||||||
|
Publish listbatchfiles Spy
|
||||||
|
Publish makemumopos User
|
||||||
|
Publish dropmumo User
|
||||||
|
Publish hdbbatchpath User
|
||||||
|
Publish cscan User
|
||||||
|
Publish sscan User
|
||||||
|
Publish scan Spy
|
||||||
|
Publish hmake Mugger
|
||||||
|
Publish hmakescript Mugger
|
||||||
|
Publish hlink Mugger
|
||||||
|
Publish hcommand Mugger
|
||||||
|
Publish hdbstorenexus User
|
||||||
|
Publish scaninfo Spy
|
||||||
|
}
|
||||||
|
#===================================================================
|
||||||
|
# Configuration commands provided:
|
||||||
|
# hdbReadOnly
|
||||||
|
# makesampleenv path
|
||||||
|
# makestdscan path
|
||||||
|
# makestdscangraphics path
|
||||||
|
# makestdbatch
|
||||||
|
# makeQuickPar name path
|
||||||
|
# makeslit path left right upper lower
|
||||||
|
# configures a slit. Missing motors can be indicated with NONE
|
||||||
|
# makestdadmin
|
||||||
|
# makecount path
|
||||||
|
# makerepeat path
|
||||||
|
# makekillfile path
|
||||||
|
# makesuccess path
|
||||||
|
# makestdgui
|
||||||
|
# makewait path
|
||||||
|
# makeevproxy rootpath hdbname devicename
|
||||||
|
# makemumo rootpath mumoname
|
||||||
|
# makeexe
|
||||||
|
# confnxhdb path alias pass
|
||||||
|
# makestddrive path
|
||||||
|
#===================== hfactory adapters ==========================
|
||||||
|
proc hmake {path priv type {len 1}} {
|
||||||
|
hfactory $path plain $priv $type $len
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc hmakescript {path readscript writescript type {len 1}} {
|
||||||
|
hfactory $path script $readscript $writescript $type $len
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc hlink {path obj {treename NONE} } {
|
||||||
|
if {[string equal $treename NONE]} {
|
||||||
|
set treename $ob
|
||||||
|
}
|
||||||
|
append realpath $path / $treename
|
||||||
|
hfactory $realpath link $obj
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc hcommand {path script} {
|
||||||
|
hfactory $path command $script
|
||||||
|
}
|
||||||
|
#================ make XML tree =====================================
|
||||||
|
proc getdataType {path} {
|
||||||
|
return [lindex [split [hinfo $path] ,] 0]
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc makeInitValue {path type prefix} {
|
||||||
|
append result ""
|
||||||
|
if {[string compare $type none] != 0 && [string compare $type func] != 0} {
|
||||||
|
set test [catch {hgetprop $path transfer} msg]
|
||||||
|
set tst [catch {hval $path} val]
|
||||||
|
if {$test != 0 && $tst == 0} {
|
||||||
|
append result "$prefix <initValue>\n"
|
||||||
|
append result "$prefix $val\n"
|
||||||
|
append result "$prefix </initValue>\n"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $result
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc make_nodes {path result indent} {
|
||||||
|
set nodename [file tail $path];
|
||||||
|
set type [getdataType $path]
|
||||||
|
set prefix [string repeat " " $indent]
|
||||||
|
set newIndent [expr $indent + 2]
|
||||||
|
#array set prop_list [ string trim [join [split [hlistprop $path] =]] ]
|
||||||
|
set prop_list(control) true
|
||||||
|
set we_have_control [info exists prop_list(control)]
|
||||||
|
if {$we_have_control == 0 || $we_have_control && $prop_list(control) == "true"} {
|
||||||
|
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
|
||||||
|
foreach p [property_elements $path $newIndent] {
|
||||||
|
append result $p
|
||||||
|
}
|
||||||
|
foreach x [hlist $path] {
|
||||||
|
set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent]
|
||||||
|
}
|
||||||
|
# append result [makeInitValue $path $type $prefix]
|
||||||
|
append result "$prefix</component>\n"
|
||||||
|
}
|
||||||
|
return $result
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc property_elements_old {path indent} {
|
||||||
|
set prefix [string repeat " " $indent]
|
||||||
|
foreach {key value} [string map {= " "} [hlistprop $path]] {
|
||||||
|
if {[string compare -nocase $key "control"] == 0} {continue}
|
||||||
|
lappend proplist "$prefix<property id=\"$key\">\n"
|
||||||
|
# foreach v [split $value ,] {
|
||||||
|
# lappend proplist "$prefix$prefix<value>$v</value>\n"
|
||||||
|
# }
|
||||||
|
lappend proplist "$prefix$prefix<value>$value</value>\n"
|
||||||
|
lappend proplist "$prefix</property>\n"
|
||||||
|
}
|
||||||
|
if [info exists proplist] {return $proplist}
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc property_elements {path indent} {
|
||||||
|
set prefix [string repeat " " $indent]
|
||||||
|
set data [hlistprop $path]
|
||||||
|
set propList [split $data \n]
|
||||||
|
foreach prop $propList {
|
||||||
|
set pl [split $prop =]
|
||||||
|
set key [string trim [lindex $pl 0]]
|
||||||
|
set value [string trim [lindex $pl 1]]
|
||||||
|
if {[string length $key] < 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
lappend proplist "$prefix<property id=\"$key\">\n"
|
||||||
|
lappend proplist "$prefix$prefix<value>$value</value>\n"
|
||||||
|
lappend proplist "$prefix</property>\n"
|
||||||
|
}
|
||||||
|
if [info exists proplist] {return $proplist}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
proc getgumtreexml {path} {
|
||||||
|
append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
|
||||||
|
append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"
|
||||||
|
|
||||||
|
if {[string compare $path "/" ] == 0} {
|
||||||
|
foreach n [hlist $path] {
|
||||||
|
set result [make_nodes /$n $result 2]
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
foreach n [hlist $path] {
|
||||||
|
set result [make_nodes $path/$n $result 2]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
append result "</hipadaba:SICS>\n"
|
||||||
|
}
|
||||||
|
#==================== Gumtree batch =========================================
|
||||||
|
proc searchPathForDrivable {name} {
|
||||||
|
set path [string trim [hmatchprop / sicsdev $name]]
|
||||||
|
if {[string compare $path NONE] != 0} {
|
||||||
|
return $path
|
||||||
|
}
|
||||||
|
set txt [findalias $name]
|
||||||
|
if {[string compare $txt NONE] == 0} {
|
||||||
|
return NONE
|
||||||
|
}
|
||||||
|
set l1 [split $txt =]
|
||||||
|
set l [split [lindex $l1 1] ,]
|
||||||
|
foreach alias $l {
|
||||||
|
set alias [string trim $alias]
|
||||||
|
set path [string trim [hmatchprop / sicsdev $alias]]
|
||||||
|
if {[string compare $path NONE] != 0} {
|
||||||
|
return $path
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return NONE
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc searchForCommand {name} {
|
||||||
|
return [string trim [hmatchprop / sicscommand $name]]
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc treatsscan {scanpath command out} {
|
||||||
|
set l [split $command]
|
||||||
|
set len [llength $l]
|
||||||
|
set noVar [expr ($len-2)/3]
|
||||||
|
set np [lindex $l [expr $len -2]]
|
||||||
|
set preset [lindex $l [expr $len -1]]
|
||||||
|
for {set i 0} {$i < $noVar} {incr i} {
|
||||||
|
set start [expr $i * 3]
|
||||||
|
set scanVar [lindex $l [expr 1 + $start]]
|
||||||
|
set scanStart [lindex $l [expr 2 + $start]]
|
||||||
|
set scanEnd [lindex $l [expr 3 + $start]]
|
||||||
|
set scanStep [expr ($scanEnd*1. - $scanStart*1.)/$np*1.]
|
||||||
|
append hdbVar $scanVar ,
|
||||||
|
append hdbStart $scanStart ,
|
||||||
|
append hdbStep $scanStep ,
|
||||||
|
}
|
||||||
|
set hdbVar [string trim $hdbVar ,]
|
||||||
|
set hdbStart [string trim $hdbStart ,]
|
||||||
|
set hdbStep [string trim $hdbStep ,]
|
||||||
|
puts $out "\#NODE: $scanpath"
|
||||||
|
puts $out "clientput BatchPos = 1"
|
||||||
|
puts $out "hdbscan $hdbVar $hdbStart $hdbStep $np monitor $preset"
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc treatcscan {scanpath command out} {
|
||||||
|
set l [split $command]
|
||||||
|
set scanVar [lindex $l 1]
|
||||||
|
set scanCenter [lindex $l 2]
|
||||||
|
set scanStep [lindex $l 3]
|
||||||
|
set np [lindex $l 4]
|
||||||
|
set preset [lindex $l 5]
|
||||||
|
set hdbStart [expr $scanCenter - ($np*1.0)/2. * $scanStep*1.0]
|
||||||
|
puts $out "\#NODE: $scanpath"
|
||||||
|
puts $out "clientput BatchPos = 1"
|
||||||
|
puts $out "hdbscan $scanVar $hdbStart $scanStep $np monitor $preset"
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc translateCommand {command out} {
|
||||||
|
set drivelist [list drive dr run]
|
||||||
|
set textList [list for while source if]
|
||||||
|
# clientput "Translating: $command"
|
||||||
|
set command [string trim $command]
|
||||||
|
if {[string length $command] < 2} {
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set l [split $command]
|
||||||
|
set obj [string trim [lindex $l 0]]
|
||||||
|
#------- check for drive commands
|
||||||
|
set idx [lsearch $drivelist $obj]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set dev [lindex $l 1]
|
||||||
|
set path [searchPathForDrivable $dev]
|
||||||
|
if {[string compare $path NONE] != 0} {
|
||||||
|
set realTxt [hgetprop $path sicsdev]
|
||||||
|
set realL [split $realTxt =]
|
||||||
|
set realDev [lindex $realL 1]
|
||||||
|
set mapList [list $dev $realDev]
|
||||||
|
set newCom [string map $mapList $command]
|
||||||
|
puts $out "\#NODE: $path"
|
||||||
|
puts $out "clientput BatchPos = 1"
|
||||||
|
puts $out $newCom
|
||||||
|
return
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------ check for well known broken commands
|
||||||
|
set idx [lsearch $textList $obj]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
puts $out "\#NODE: /batch/commandtext"
|
||||||
|
puts $out "clientput BatchPos = 1"
|
||||||
|
set buffer [string map {\n @nl@} $command]
|
||||||
|
puts $out "hset /batch/commandtext $buffer"
|
||||||
|
return
|
||||||
|
}
|
||||||
|
#--------- check for simple commands
|
||||||
|
set path [searchForCommand $command]
|
||||||
|
if {[string compare $path NONE] != 0} {
|
||||||
|
puts $out "\#NODE: $path"
|
||||||
|
puts $out "clientput BatchPos = 1"
|
||||||
|
puts $out $command
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set scancom [searchForCommand hdbscan]
|
||||||
|
#---------- deal with scans
|
||||||
|
if {[string first sscan $obj] >= 0} {
|
||||||
|
if {[catch {treatsscan $scancom $command $out}] == 0} {
|
||||||
|
return
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {[string first cscan $obj] >= 0} {
|
||||||
|
if {[catch {treatsscan $scancom $command $out}] == 0} {
|
||||||
|
return
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------- give up: output as a text node
|
||||||
|
puts $out "\#NODE: /batch/commandtext"
|
||||||
|
puts $out "clientput BatchPos = 1"
|
||||||
|
set buffer [string map {\n @nl@} $command]
|
||||||
|
puts $out "hset /batch/commandtext $buffer"
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc mgbatch {filename} {
|
||||||
|
global tmppath
|
||||||
|
set f [open $filename r]
|
||||||
|
gets $f line
|
||||||
|
close $f
|
||||||
|
if {[string first MOUNTAINBATCH $line] > 0} {
|
||||||
|
#--------- This is a mountaingum batch file which does not need
|
||||||
|
# to be massaged
|
||||||
|
return $filename
|
||||||
|
}
|
||||||
|
set f [open $filename r]
|
||||||
|
set realfilename [file tail $filename]
|
||||||
|
set out [open $tmppath/$realfilename w]
|
||||||
|
puts $out \#MOUNTAINBATCH
|
||||||
|
while {[gets $f line] >= 0} {
|
||||||
|
append buffer $line
|
||||||
|
if {[info complete $buffer] == 1} {
|
||||||
|
translateCommand $buffer $out
|
||||||
|
unset buffer
|
||||||
|
} else {
|
||||||
|
append buffer \n
|
||||||
|
}
|
||||||
|
}
|
||||||
|
close $out
|
||||||
|
return $tmppath/$realfilename
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc loadmgbatch {filename} {
|
||||||
|
set txt [exe fullpath $filename]
|
||||||
|
set l [split $txt =]
|
||||||
|
set realf [lindex $l 1]
|
||||||
|
set realf [mgbatch $realf]
|
||||||
|
return [exe print $realf]
|
||||||
|
}
|
||||||
|
#============== hdbscan =========================================
|
||||||
|
proc hdbscan {scanvars scanstart scanincr np mode preset} {
|
||||||
|
global stdscangraph hdbscanactive
|
||||||
|
xxxscan clear
|
||||||
|
xxxscan configure script
|
||||||
|
xxxscan function prepare hdbprepare
|
||||||
|
xxxscan function collect hdbcollect
|
||||||
|
set varlist [split $scanvars ,]
|
||||||
|
set startlist [split $scanstart ,]
|
||||||
|
set incrlist [split $scanincr ,]
|
||||||
|
catch {hset $stdscangraph/scan_variable/name [lindex $varlist 0]}
|
||||||
|
set count 0
|
||||||
|
foreach var $varlist {
|
||||||
|
if {[string first / $var] >= 0} {
|
||||||
|
set var [string trim [SplitReply [hgetprop $var sicsdev]]]
|
||||||
|
}
|
||||||
|
xxxscan add $var [lindex $startlist $count] [lindex $incrlist $count]
|
||||||
|
incr count
|
||||||
|
}
|
||||||
|
set hdbscanactive 1
|
||||||
|
set status [catch {xxxscan run $np $mode $preset} msg]
|
||||||
|
set hdbscanactive 0
|
||||||
|
if {$status == 0} {
|
||||||
|
return $msg
|
||||||
|
} else {
|
||||||
|
error $msg
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------------
|
||||||
|
proc hdbprepare {obj userdata } {
|
||||||
|
global stdscangraph
|
||||||
|
stdscan prepare $obj userdata
|
||||||
|
catch {hupdate $stdscangraph/dim}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------------
|
||||||
|
proc hdbcollect {obj userobj np} {
|
||||||
|
global stdscangraph
|
||||||
|
stdscan collect $obj $userobj $np
|
||||||
|
catch {hupdate $stdscangraph/scan_variable}
|
||||||
|
catch {hupdate $stdscangraph/counts}
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------------
|
||||||
|
proc gethdbscanvardata {no} {
|
||||||
|
set np [string trim [SplitReply [xxxscan np]]]
|
||||||
|
if {$np == 0} {
|
||||||
|
return ".0 .0 .0"
|
||||||
|
}
|
||||||
|
set status [catch {SplitReply [xxxscan getvardata $no]} txt]
|
||||||
|
if {$status == 0} {
|
||||||
|
return [join $txt]
|
||||||
|
} else {
|
||||||
|
return ".0 .0 .0"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
proc gethdbscancounts {} {
|
||||||
|
set np [string trim [SplitReply [xxxscan np]]]
|
||||||
|
if {$np == 0} {
|
||||||
|
return "0 0 0"
|
||||||
|
}
|
||||||
|
set status [catch {SplitReply [xxxscan getcounts]} txt]
|
||||||
|
if {$status == 0} {
|
||||||
|
return [join $txt]
|
||||||
|
} else {
|
||||||
|
return "0 0 0"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#================= helper to get the list of batch files =================
|
||||||
|
proc listbatchfiles {} {
|
||||||
|
set ext [list *.tcl *.job *.run]
|
||||||
|
set txt [SplitReply [exe batchpath]]
|
||||||
|
set dirlist [split $txt :]
|
||||||
|
set txt [SplitReply [exe syspath]]
|
||||||
|
set dirlist [concat $dirlist [split $txt :]]
|
||||||
|
# clientput $dirlist
|
||||||
|
set result [list ""]
|
||||||
|
foreach dir $dirlist {
|
||||||
|
foreach e $ext {
|
||||||
|
set status [catch {glob [string trim $dir]/$e} filetxt]
|
||||||
|
if {$status == 0} {
|
||||||
|
set filelist [split $filetxt]
|
||||||
|
foreach f $filelist {
|
||||||
|
# clientput "Working at $f"
|
||||||
|
set nam [file tail $f]
|
||||||
|
if { [lsearch $result $nam] < 0} {
|
||||||
|
# clientput "Adding $nam"
|
||||||
|
lappend result $nam
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
# clientput "ERROR: $filetxt"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
foreach bf $result {
|
||||||
|
append resulttxt $bf ,
|
||||||
|
}
|
||||||
|
return [string trim $resulttxt ,]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc hsearchprop {root prop val} {
|
||||||
|
set children [hlist $root]
|
||||||
|
set childlist [split $children \n]
|
||||||
|
if {[llength $childlist] <= 0} {
|
||||||
|
error "No children"
|
||||||
|
}
|
||||||
|
foreach child $childlist {
|
||||||
|
if {[string length $child] < 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
catch {hgetprop $root/$child $prop} msg
|
||||||
|
if { [string first ERROR $msg] < 0} {
|
||||||
|
set value [string trim [SplitReply $msg]]
|
||||||
|
if { [string equal -nocase $value $val] == 1} {
|
||||||
|
return $root/$child
|
||||||
|
}
|
||||||
|
}
|
||||||
|
set status [catch {hsearchprop $root/$child $prop $val} node]
|
||||||
|
if {$status == 0} {
|
||||||
|
return $node
|
||||||
|
}
|
||||||
|
}
|
||||||
|
error "Not found"
|
||||||
|
}
|
||||||
|
#============ various utility routines =====================================
|
||||||
|
proc hdbReadOnly args {
|
||||||
|
error "Parameter is READ ONLY"
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
proc makesampleenv {path} {
|
||||||
|
hfactory $path plain spy none
|
||||||
|
hsetprop $path type graphdata
|
||||||
|
hsetprop $path viewer mountaingumui.TimeSeries
|
||||||
|
hfactory $path/vars plain user text
|
||||||
|
hset $path/vars tomato
|
||||||
|
hfactory $path/rank plain user int
|
||||||
|
hset $path/rank 1
|
||||||
|
hfactory $path/dim plain user intar 1
|
||||||
|
hset $path/dim 300
|
||||||
|
hfactory $path/getdata plain user text
|
||||||
|
hsetprop $path/getdata type logcommand
|
||||||
|
hfactory $path/getdata/2010ttime plain spy text
|
||||||
|
hfactory $path/getdata/2010ime plain spy text
|
||||||
|
}
|
||||||
|
#--------------------------------------------------
|
||||||
|
proc makestdscan {path} {
|
||||||
|
hfactory $path command hdbscan
|
||||||
|
hsetprop $path type command
|
||||||
|
hsetprop $path viewer mountaingumui.ScanEditor
|
||||||
|
hsetprop $path priv user
|
||||||
|
hfactory $path/scan_variables plain user text
|
||||||
|
hsetprop $path/scan_variables argtype drivable
|
||||||
|
hfactory $path/scan_start plain user text
|
||||||
|
hfactory $path/scan_increments plain user text
|
||||||
|
hfactory $path/NP plain user int
|
||||||
|
hfactory $path/mode plain user text
|
||||||
|
hsetprop $path/mode values "monitor,timer"
|
||||||
|
hfactory $path/preset plain user float
|
||||||
|
}
|
||||||
|
#---------------------------------------------------
|
||||||
|
proc makestdscangraphics {path} {
|
||||||
|
global stdscangraph
|
||||||
|
|
||||||
|
set stdscangraph $path
|
||||||
|
|
||||||
|
hfactory $path plain spy none
|
||||||
|
hsetprop $path type graphdata
|
||||||
|
hsetprop $path viewer default
|
||||||
|
hattach $path title title
|
||||||
|
hfactory $path/rank plain mugger int
|
||||||
|
hset $path/rank 1
|
||||||
|
hsetprop $path/rank priv internal
|
||||||
|
hfactory $path/dim script "xxxscan np" hdbReadOnly intar 1
|
||||||
|
hsetprop $path/dim priv internal
|
||||||
|
hfactory $path/scan_variable script "gethdbscanvardata 0" hdbReadOnly floatvarar 1
|
||||||
|
hsetprop $path/scan_variable type axis
|
||||||
|
hsetprop $path/scan_variable dim 0
|
||||||
|
hsetprop $path/scan_variable transfer zip
|
||||||
|
hsetprop $path/scan_variable priv internal
|
||||||
|
hfactory $path/scan_variable/name plain user text
|
||||||
|
hfactory $path/counts script "gethdbscancounts" hdbReadOnly intvarar 1
|
||||||
|
hsetprop $path/counts type data
|
||||||
|
hsetprop $path/counts transfer zip
|
||||||
|
hsetprop $path/counts priv internal
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc makeQuickPar {name path} {
|
||||||
|
hfactory /quickview/$name plain mugger text
|
||||||
|
hset /quickview/$name $path
|
||||||
|
}
|
||||||
|
#---------------------------------------------------
|
||||||
|
proc makestdbatch {} {
|
||||||
|
hfactory /batch plain spy none
|
||||||
|
hfactory /batch/bufferlist script listbatchfiles hdbReadOnly text
|
||||||
|
sicspoll add /batch/bufferlist hdb 30
|
||||||
|
hfactory /batch/commandtext plain spy text
|
||||||
|
hsetprop /batch/commandtext viewer mountaingumui.TextEdit
|
||||||
|
hsetprop /batch/commandtext commandtext true
|
||||||
|
hfactory /batch/currentline plain user int
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------
|
||||||
|
proc makeslit {path left right upper bottom} {
|
||||||
|
hfactory $path plain spy none
|
||||||
|
hsetprop $path type part
|
||||||
|
if {![string equal $left NONE]} {
|
||||||
|
hattach $path $left left
|
||||||
|
}
|
||||||
|
if {![string equal $right NONE]} {
|
||||||
|
hattach $path $right right
|
||||||
|
}
|
||||||
|
if {![string equal $upper NONE]} {
|
||||||
|
hattach $path $upper upper
|
||||||
|
}
|
||||||
|
if {![string equal $bottom NONE]} {
|
||||||
|
hattach $path $bottom bottom
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc makestdadmin {} {
|
||||||
|
hfactory /instrument/experiment plain spy none
|
||||||
|
hattach /instrument/experiment title title
|
||||||
|
hattach /instrument/experiment user user
|
||||||
|
set status [catch {hattach /instrument/experiment/user adress address} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
set status [catch {hattach /instrument/experiment/user address address} msg]
|
||||||
|
}
|
||||||
|
hattach /instrument/experiment/user phone phone
|
||||||
|
hattach /instrument/experiment/user email email
|
||||||
|
hfactory /instrument/experiment/datafilenumber script sicsdatanumber \
|
||||||
|
hdbReadOnly int
|
||||||
|
hsetprop /instrument/experiment/datafilenumber priv internal
|
||||||
|
hfactory /instrument/experiment/batchpath script "exe batchpath" \
|
||||||
|
hdbbatchpath text
|
||||||
|
hsetprop /instrument/experiment/batchpath priv user
|
||||||
|
sicspoll add /instrument/experiment/batchpath hdb 60
|
||||||
|
sicspoll add /instrument/experiment/datafilenumber hdb 60
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------
|
||||||
|
proc makecount {path} {
|
||||||
|
hfactory $path command count
|
||||||
|
hsetprop $path type command
|
||||||
|
hsetprop $path priv user
|
||||||
|
hfactory $path/mode plain user text
|
||||||
|
hsetprop $path/mode values "monitor,timer"
|
||||||
|
hfactory $path/preset plain user float
|
||||||
|
hset $path/preset 60000
|
||||||
|
hset $path/mode monitor
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------
|
||||||
|
proc makerepeat {path} {
|
||||||
|
hfactory $path command repeat
|
||||||
|
hsetprop $path type command
|
||||||
|
hsetprop $path priv user
|
||||||
|
hfactory $path/num plain user int
|
||||||
|
hfactory $path/mode plain user text
|
||||||
|
hsetprop $path/mode values "monitor,timer"
|
||||||
|
hfactory $path/preset plain user float
|
||||||
|
hset $path/preset 60000
|
||||||
|
hset $path/mode monitor
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------
|
||||||
|
proc makekillfile {path} {
|
||||||
|
hcommand $path killfile
|
||||||
|
hsetprop $path type command
|
||||||
|
hsetprop $path priv manager
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------
|
||||||
|
proc makesuccess {path} {
|
||||||
|
hcommand $path success
|
||||||
|
hsetprop $path type command
|
||||||
|
hsetprop $path priv user
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------
|
||||||
|
proc makestdgui {} {
|
||||||
|
hfactory /gui plain spy none
|
||||||
|
hfactory /gui/status plain internal text
|
||||||
|
status hdbinterest /gui/status
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------
|
||||||
|
proc makewait {path} {
|
||||||
|
hfactory $path command wait
|
||||||
|
hsetprop $path type command
|
||||||
|
hsetprop $path priv user
|
||||||
|
hfactory $path/time plain user int
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------
|
||||||
|
proc makeevproxy {rootpath hdbname devicename} {
|
||||||
|
MakeProxy p${devicename} $devicename float
|
||||||
|
p${devicename} map upperlimit upperlimit float user
|
||||||
|
p${devicename} map lowerlimit lowerlimit float user
|
||||||
|
hlink $rootpath p${devicename} $hdbname
|
||||||
|
hsetprop $rootpath/$hdbname sicsdev $devicename
|
||||||
|
hsetprop $rootpath/$hdbname type drivable
|
||||||
|
sicspoll add $rootpath/$hdbname hdb 30
|
||||||
|
}
|
||||||
|
#================== multi motor stuff =======================
|
||||||
|
proc getNamposList {mumo} {
|
||||||
|
set txt [$mumo list]
|
||||||
|
set l [split $txt "\n"]
|
||||||
|
set lala [llength $l]
|
||||||
|
for {set i 1} {$i < [llength $l]} {incr i} {
|
||||||
|
set pos [lindex $l $i]
|
||||||
|
if {[string length $pos] > 1} {
|
||||||
|
append result [lindex $l $i] ","
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if { ![info exists result] } {
|
||||||
|
# clientput "nampos = $txt"
|
||||||
|
append result UNKNOWN
|
||||||
|
}
|
||||||
|
return [string trimright $result ","]
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------
|
||||||
|
proc getNamPos {mumo} {
|
||||||
|
set txt [$mumo find]
|
||||||
|
set l [split $txt =]
|
||||||
|
return [string trim [lindex $l 1]]
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------
|
||||||
|
proc updateNamePosValues {rootpath} {
|
||||||
|
hupdate $rootpath/namedposition/values
|
||||||
|
hupdate $rootpath/dropnamedposition/name/values
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------
|
||||||
|
proc makemumopos {mumo rootpath name} {
|
||||||
|
$mumo pos $name
|
||||||
|
updateNamePosValues $rootpath
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------
|
||||||
|
proc dropmumo {mumo rootpath name} {
|
||||||
|
$mumo drop $name
|
||||||
|
updateNamePosValues $rootpath
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------
|
||||||
|
proc getDropList {mumo} {
|
||||||
|
set txt [getNamposList $mumo]
|
||||||
|
append txt ",all"
|
||||||
|
return $txt
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc makemumo {rootpath mumoname} {
|
||||||
|
hfactory $rootpath/namedposition script "getNamPos $mumoname" \
|
||||||
|
$mumoname text
|
||||||
|
hsetprop $rootpath/namedposition priv user
|
||||||
|
hfactory $rootpath/namedposition/values script \
|
||||||
|
"getNamposList $mumoname" hdbReadOnly text
|
||||||
|
hsetprop $rootpath/namedposition/values visible false
|
||||||
|
hupdate $rootpath/namedposition/values
|
||||||
|
hfactory $rootpath/assignname2current command \
|
||||||
|
"makemumopos $mumoname $rootpath"
|
||||||
|
hsetprop $rootpath/assignname2current priv user
|
||||||
|
hsetprop $rootpath/assignname2current type command
|
||||||
|
hfactory $rootpath/assignname2current/name plain user text
|
||||||
|
hset $rootpath/assignname2current/name "Undefined"
|
||||||
|
hfactory $rootpath/dropnamedposition command \
|
||||||
|
"dropmumo $mumoname $rootpath"
|
||||||
|
hsetprop $rootpath/dropnamedposition priv user
|
||||||
|
hsetprop $rootpath/dropnamedposition type command
|
||||||
|
hfactory $rootpath/dropnamedposition/name plain user text
|
||||||
|
hfactory $rootpath/dropnamedposition/name/values script \
|
||||||
|
"getDropList $mumoname" hdbReadOnly text
|
||||||
|
hsetprop $rootpath/dropnamedposition/name/values visible false
|
||||||
|
hupdate $rootpath/dropnamedposition/name/values
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------
|
||||||
|
proc hdbbatchpath {pathstring} {
|
||||||
|
exe batchpath $pathstring
|
||||||
|
catch {batchroot $pathstring}
|
||||||
|
catch {hupdate /instrument/commands/batch/execute/file/values}
|
||||||
|
catch {hupdate /instrument/commands/batch/batchpath}
|
||||||
|
catch {hupdate /instrument/experiment/batchpath}
|
||||||
|
catch {hupdate /batch/bufferlist}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc makeexe {} {
|
||||||
|
set path /instrument/commands/batch
|
||||||
|
hfactory $path plain spy none
|
||||||
|
hfactory $path/batchpath script "exe batchpath" hdbbatchpath text
|
||||||
|
hsetprop $path/batchpath priv user
|
||||||
|
hfactory $path/execute command exe
|
||||||
|
hsetprop $path/execute type command
|
||||||
|
hsetprop $path/execute priv user
|
||||||
|
hfactory $path/execute/file plain user text
|
||||||
|
hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text
|
||||||
|
sicspoll add $path/execute/file/values hdb 60
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc confnxhdb {path alias pass} {
|
||||||
|
hsetprop $path nxalias $alias
|
||||||
|
hsetprop $path nxpass $pass
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc hdbstorenexus args {
|
||||||
|
if {[llength $args] < 2} {
|
||||||
|
error "hdbstorenexus called with insufficient number of arguments"
|
||||||
|
}
|
||||||
|
set path [lindex $args 0]
|
||||||
|
set pass [lindex $args 1]
|
||||||
|
set childlist [split [hlist $path] \n]
|
||||||
|
foreach child $childlist {
|
||||||
|
if {[string length $child] < 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
set status [catch {hgetpropval $path/$child nxpass} passval]
|
||||||
|
if {$status == 0} {
|
||||||
|
set status [catch {hgetpropval $path/$child nxslab} slabval]
|
||||||
|
# ------- slabbed writing
|
||||||
|
if {$status == 0 && [string first $pass $passval] >= 0} {
|
||||||
|
set slabsizes [eval $slabval [lrange $args 2 end]]
|
||||||
|
nxscript puthdbslab $path/$child [lindex $slabsizes 0] [lindex $slabsizes 1]
|
||||||
|
}
|
||||||
|
#--------- normal writing
|
||||||
|
if {[string first $pass $passval] >= 0} {
|
||||||
|
nxscript puthdb $path/$child
|
||||||
|
}
|
||||||
|
}
|
||||||
|
eval hdbstorenexus $path/$child $pass [lrange $args 2 end]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#===================== Syntactical sugar around hdbscan ===================
|
||||||
|
# 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 1997
|
||||||
|
#
|
||||||
|
# Reworked for hdbscan, Mark Koennecke, November 2008
|
||||||
|
#-----------------------------------------------------------------------------
|
||||||
|
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
|
||||||
|
}
|
||||||
|
set mode [string trim [SplitReply [scan mode]]]
|
||||||
|
#-------- store command in lastscancommand
|
||||||
|
set txt [format "cscan %s %s %s %s %s" $var $center \
|
||||||
|
$delta $np $preset]
|
||||||
|
catch {lastscancommand $txt}
|
||||||
|
#--------- calculate start and do scan
|
||||||
|
set start [expr $center - $np * $delta]
|
||||||
|
set ret [catch {hdbscan $var $start $delta [expr ($np * 2) + 1] $mode $preset} msg]
|
||||||
|
if { $ret != 0} {
|
||||||
|
error $msg
|
||||||
|
} else {
|
||||||
|
return $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
|
||||||
|
}
|
||||||
|
#--------- 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
|
||||||
|
append scanvars $var ","
|
||||||
|
append scanstarts $start ","
|
||||||
|
set step [expr double($end - $start)/double($np-1)]
|
||||||
|
append scansteps $step ","
|
||||||
|
}
|
||||||
|
#------------- set lastcommand text
|
||||||
|
set txt [format "sscan %s" [join $args]]
|
||||||
|
catch {lastscancommand $txt}
|
||||||
|
#------------- start scan
|
||||||
|
set scanvars [string trim $scanvars ,]
|
||||||
|
set scanstarts [string trim $scanstarts ,]
|
||||||
|
set scansteps [string trim $scansteps ,]
|
||||||
|
set mode [string trim [SplitReply [scan mode]]]
|
||||||
|
set ret [catch {hdbscan $scanvars $scanstarts $scansteps $np $mode $preset} msg]
|
||||||
|
if {$ret != 0} {
|
||||||
|
error $msg
|
||||||
|
} else {
|
||||||
|
return $msg
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------------
|
||||||
|
proc splitScanVar {txt} {
|
||||||
|
set l1 [split $txt =]
|
||||||
|
set var [lindex $l1 0]
|
||||||
|
set vl [split $var .]
|
||||||
|
lappend result [lindex $vl 1]
|
||||||
|
lappend result [string trim [lindex $l1 1]]
|
||||||
|
lappend result [string trim [lindex $l1 2]]
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------------
|
||||||
|
proc scaninfo {} {
|
||||||
|
set novar [string trim [SplitReply [xxxscan noscanvar]]]
|
||||||
|
if {$novar == 0} {
|
||||||
|
return "0,1,NONE,0.,0.,default.dat"
|
||||||
|
}
|
||||||
|
append result "scaninfo = "
|
||||||
|
append result [string trim [SplitReply [xxxscan np]]] "," $novar
|
||||||
|
for {set i 0} {$i < $novar} {incr i} {
|
||||||
|
set vl [splitScanVar [xxxscan getvarpar $i]]
|
||||||
|
append result ", " [lindex $vl 0]
|
||||||
|
}
|
||||||
|
set vl [splitScanVar [xxxscan getvarpar 0]]
|
||||||
|
append result "," [lindex $vl 1]
|
||||||
|
append result "," [lindex $vl 2]
|
||||||
|
append result "," [SplitReply [xxxscan getfile]]
|
||||||
|
append result "," [SplitReply [sample]]
|
||||||
|
append result "," [sicstime]
|
||||||
|
append result "," [SplitReply [lastscancommand]]
|
||||||
|
return $result
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc scan args {
|
||||||
|
if {[llength $args] < 1} {
|
||||||
|
error "Need keyword for scan"
|
||||||
|
}
|
||||||
|
set key [string trim [lindex $args 0]]
|
||||||
|
switch $key {
|
||||||
|
uuinterest { return [xxxscan uuinterest] }
|
||||||
|
pinterest {}
|
||||||
|
getcounts { set cts [SplitReply [xxxscan getcounts]]
|
||||||
|
return "scan.Counts = $cts"
|
||||||
|
}
|
||||||
|
mode {
|
||||||
|
if {[llength $args] > 1} {
|
||||||
|
return [counter mode [lindex $args 1]]
|
||||||
|
} else {
|
||||||
|
return [counter mode]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
clear {
|
||||||
|
return [xxxscan clear]
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
error "scan does not support keyword $key"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc makestddrive {path} {
|
||||||
|
hfactory $path command drive
|
||||||
|
hsetprop $path type command
|
||||||
|
hsetprop $path viewer mountaingumui.DriveEditor
|
||||||
|
hsetprop $path priv user
|
||||||
|
hfactory $path/motor plain user text
|
||||||
|
hsetprop $path/motor argtype drivable
|
||||||
|
hfactory $path/value plain user float
|
||||||
|
}
|
||||||
Binary file not shown.
@@ -0,0 +1,82 @@
|
|||||||
|
#---------------------------------------------------------------------------
|
||||||
|
# These scripts save and load motor positions for EL734 motors connected
|
||||||
|
# directly to SICS through the terminal server. For all others, use
|
||||||
|
# David Madens el734_motor program
|
||||||
|
#
|
||||||
|
# Mark Koennecke, April 2004
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
|
||||||
|
if { ![info exists motorhpscript] } {
|
||||||
|
set motorhpscript 1
|
||||||
|
Publish motorinternsave Mugger
|
||||||
|
Publish motorsave Mugger
|
||||||
|
Publish motorload Mugger
|
||||||
|
Publish loadmotordir Mugger
|
||||||
|
Publish savemotorarray Mugger
|
||||||
|
}
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
# save motor parameters from controller, number to file described by
|
||||||
|
# file descriptor fd
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc motorinternsave {controller number fd} {
|
||||||
|
lappend parlist mn ec ep a fd fm d e f g h j k l m q t v w z mem
|
||||||
|
puts $fd [format "%s send ec %d 0 0" $controller $number]
|
||||||
|
foreach e $parlist {
|
||||||
|
set data [$controller send $e $number]
|
||||||
|
puts $fd [format "%s send %s %d %s" $controller $e $number $data]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
# save a motor parameter set to a directory. The filename is automatically
|
||||||
|
# created in order to help motorload
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc motorsave {controller number dirname} {
|
||||||
|
set filename [format "%s/%s%2.2d.par" $dirname $controller $number]
|
||||||
|
set f [open $filename w]
|
||||||
|
motorinternsave $controller $number $f
|
||||||
|
close $f
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# Loading motor parameters. Because some of the commands change the position
|
||||||
|
# of the motor, the position is saved first and redefined after processing
|
||||||
|
# the data. It is assumed that the filename is in the format as made
|
||||||
|
# by motorsave.
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
proc motorload {filename} {
|
||||||
|
set fil [file tail $filename]
|
||||||
|
set ind [string last . $fil]
|
||||||
|
set number [string range $fil [expr $ind - 2] [expr $ind - 1]]
|
||||||
|
set controller [string range $fil 0 [expr $ind - 3]]
|
||||||
|
set pos [$controller send u $number]
|
||||||
|
fileeval $filename
|
||||||
|
$controller send uu $number $pos
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
# load a motor directory
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc loadmotordir {dirname} {
|
||||||
|
set l [glob $dirname/*.par]
|
||||||
|
foreach e $l {
|
||||||
|
set ret [catch {motorload $e} msg]
|
||||||
|
if { $ret != 0} {
|
||||||
|
clientput "ERROR: failed to load $e with $msg"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
# save a whole array of motors. The array must have the following form:
|
||||||
|
# An entry: controllerlist conatins a list of all controllers
|
||||||
|
# There exists an entry with the controller name in the array which contains
|
||||||
|
# a list of motor number
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc savemotorarray {motar dir} {
|
||||||
|
upvar $motar motorarray
|
||||||
|
set controllerList $motorarray(controllerlist)
|
||||||
|
foreach controller $controllerList {
|
||||||
|
set motlist $motorarray($controller)
|
||||||
|
foreach mot $motlist {
|
||||||
|
motorsave $controller $mot $dir
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -0,0 +1,126 @@
|
|||||||
|
#===========================================================================
|
||||||
|
# Support routines for scripting NeXus files with nxscript.
|
||||||
|
#
|
||||||
|
# Mark Koennecke, February 2003
|
||||||
|
# Mark Koennecke, January 2004
|
||||||
|
#==========================================================================
|
||||||
|
proc makeFileName args {
|
||||||
|
sicsdatanumber incr
|
||||||
|
set num [SplitReply [sicsdatanumber]]
|
||||||
|
set p [string trim [SplitReply [sicsdatapath]]]
|
||||||
|
set pre [string trim [SplitReply [sicsdataprefix]]]
|
||||||
|
set po [string trim [SplitReply [sicsdatapostfix]]]
|
||||||
|
return [format "%s%s%5.5d2003%s" $p $pre $num $po]
|
||||||
|
}
|
||||||
|
#==========================================================================
|
||||||
|
# new version, attending to the new 1000 grouping logic
|
||||||
|
proc newFileName args {
|
||||||
|
set ret [catch {nxscript makefilename} msg]
|
||||||
|
if {$ret != 0} {
|
||||||
|
clientput "ERROR: Misconfiguration of file writing variables"
|
||||||
|
clientput "Defaulting filename to emergency.hdf"
|
||||||
|
set fil emergency.hdf
|
||||||
|
} else {
|
||||||
|
set fil $msg
|
||||||
|
}
|
||||||
|
return $fil
|
||||||
|
}
|
||||||
|
#==========================================================================
|
||||||
|
proc writeFloatVar {alias var} {
|
||||||
|
set ret [catch {set val [SplitReply [$var]]} val]
|
||||||
|
if { $ret != 0} {
|
||||||
|
clientput [format "ERROR: failed to read %s, %s" $var $val]
|
||||||
|
return
|
||||||
|
} else {
|
||||||
|
set val [string trim $val]
|
||||||
|
set ret [catch {expr $val * 1.0} val]
|
||||||
|
if { $ret == 0} {
|
||||||
|
nxscript putfloat $alias [expr $val * 1.0 ]
|
||||||
|
} else {
|
||||||
|
clientput "ERROR: bad value $val when reading $var"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#==========================================================================
|
||||||
|
proc writeIntVar {alias var} {
|
||||||
|
set ret [catch {set val [SplitReply [$var]]} val]
|
||||||
|
if { $ret != 0} {
|
||||||
|
clientput [format "ERROR: failed to read %s, %s" $var $val]
|
||||||
|
return
|
||||||
|
} else {
|
||||||
|
set val [string trim $val]
|
||||||
|
set ret [catch {expr $val * 1.0} val]
|
||||||
|
if { $ret == 0} {
|
||||||
|
nxscript putint $alias [expr int($val * 1.0) ]
|
||||||
|
} else {
|
||||||
|
clientput "ERROR: bad value $val when reading $var"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#=========================================================================
|
||||||
|
proc writeTextVar {alias var} {
|
||||||
|
set ret [catch {$var} val]
|
||||||
|
if { $ret != 0} {
|
||||||
|
clientput [format "ERROR: failed to read %s" $var]
|
||||||
|
return
|
||||||
|
} else {
|
||||||
|
set index [string first = $val]
|
||||||
|
if {$index >= 0} {
|
||||||
|
set txt [string trim [string range $val [expr $index + 1] end]]
|
||||||
|
nxscript puttext $alias $txt
|
||||||
|
} else {
|
||||||
|
clientput [format "ERROR: failed to read %s" $var]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#========================================================================
|
||||||
|
proc writeTextAttribute {attName var} {
|
||||||
|
set ret [catch {set val [SplitReply [$var]]} val]
|
||||||
|
if { $ret != 0} {
|
||||||
|
clientput [format "ERROR: failed to read %s" $var]
|
||||||
|
return
|
||||||
|
} else {
|
||||||
|
nxscript putglobal $attName [string trim $val]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#=======================================================================
|
||||||
|
proc writeStandardAttributes {fileName} {
|
||||||
|
nxscript putglobal file_name $fileName
|
||||||
|
nxscript putglobal file_time [sicstime]
|
||||||
|
writeTextAttribute instrument instrument
|
||||||
|
writeTextAttribute owner user
|
||||||
|
writeTextAttribute owner_telephone_number phone
|
||||||
|
writeTextAttribute owner_fax_number fax
|
||||||
|
writeTextAttribute owner_email email
|
||||||
|
writeTextAttribute owner_address address
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc appendMotor {np motor alias} {
|
||||||
|
set val [SplitReply [$motor]]
|
||||||
|
__transfer putfloat 0 $val
|
||||||
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc appendFloat {np alias val} {
|
||||||
|
__transfer putfloat 0 $val
|
||||||
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc appendCount {np value alias} {
|
||||||
|
__transfer putint 0 $value
|
||||||
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc appendSampleEnv {np device alias} {
|
||||||
|
#--------- test for presence
|
||||||
|
set status [catch {SplitReply [$device]} val]
|
||||||
|
if {$status != 0} {
|
||||||
|
return
|
||||||
|
}
|
||||||
|
#--------- test for validity
|
||||||
|
set status [catch {expr $val * 1.0} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
return
|
||||||
|
}
|
||||||
|
appendFloat $np $alias $val
|
||||||
|
}
|
||||||
@@ -0,0 +1,311 @@
|
|||||||
|
#------------------------------------------------------------------
|
||||||
|
# This is driver for the combination Phytron MCC-2 Motor Controller
|
||||||
|
# and SICS using the scriptcontext asynchronous I/O system. The
|
||||||
|
# MCC-2 has a funny protocl as that messages are enclosed into
|
||||||
|
# <STX> data <ETX> sequences. This protocol is handled by the
|
||||||
|
# C-language phytron protocol handler. Per default, the MCC-2 is
|
||||||
|
# configured to use 57600 baud. I have configured it to use 9600
|
||||||
|
# baud and it ought to remember this. The command to change this
|
||||||
|
# 0IC1S9600, the command to read this is 0IC1R.
|
||||||
|
#
|
||||||
|
# So, if this thing does not work on a serial port then the solution is
|
||||||
|
# to set the terminal server to 57600 and try again. And set the baud rate
|
||||||
|
# or leave it.
|
||||||
|
#
|
||||||
|
# There are surely many ways to use the MCC-2. It supports two axes, X and Y.
|
||||||
|
# All examples below are given for X only. This driver uses it in
|
||||||
|
# this way:
|
||||||
|
#
|
||||||
|
# Nothing works properly without a reference run. The reference run is done
|
||||||
|
# in the following way:
|
||||||
|
# 1) Send it into the negative limit switch with 0X0-
|
||||||
|
# 2) Set the mechanical position with 0XP20Swert to the negative limit
|
||||||
|
# 3) Set the encoder position with 0XP22Swert to the negative limit
|
||||||
|
#
|
||||||
|
# Position ever afterwards with 0XAwert, read encoder with 0XP22R
|
||||||
|
#
|
||||||
|
# While driving 0X=H return ACKN, else ACKE
|
||||||
|
#
|
||||||
|
# Stopping goes via 0XSN
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Script chains:
|
||||||
|
#
|
||||||
|
# - reading position:
|
||||||
|
# readpos - posrcv
|
||||||
|
#
|
||||||
|
# - writing postion:
|
||||||
|
# setpos - setrcv
|
||||||
|
#
|
||||||
|
# - reading status:
|
||||||
|
# sendstatus - rcvstatus - statpos
|
||||||
|
#
|
||||||
|
# - reading speed:
|
||||||
|
# readspeed - rcvspeed
|
||||||
|
#
|
||||||
|
# - setting speed:
|
||||||
|
# writespeed - rcvwspeed - rcvspeed
|
||||||
|
#
|
||||||
|
# Mark Koennecke, June 2009
|
||||||
|
#
|
||||||
|
# Added code to switch a brake on for schneider_m2
|
||||||
|
#
|
||||||
|
# Mark Koennecke, September 2009
|
||||||
|
#
|
||||||
|
# Added code to support the speed parameter
|
||||||
|
#
|
||||||
|
# Mark Koennecke, December 2009
|
||||||
|
#
|
||||||
|
# Added more code to configure non encoder phytron motors which need to
|
||||||
|
# read another parameter for position
|
||||||
|
#
|
||||||
|
# Mark Koennecke, January 2011
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
|
||||||
|
namespace eval phytron {}
|
||||||
|
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc phytron::check {} {
|
||||||
|
set data [sct result]
|
||||||
|
if {[string first AscErr $data] >= 0} {
|
||||||
|
error $data
|
||||||
|
}
|
||||||
|
return $data
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::readpos {axis enc} {
|
||||||
|
# the following command must be P20R without encoder, P22R with encoder
|
||||||
|
if {$enc == 1} {
|
||||||
|
sct send "0${axis}P22R"
|
||||||
|
} else {
|
||||||
|
sct send "0${axis}P20R"
|
||||||
|
}
|
||||||
|
return posrcv
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::posrcv {} {
|
||||||
|
set data [phytron::check]
|
||||||
|
set pos [string range $data 3 end]
|
||||||
|
sct update $pos
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::setpos {axis name} {
|
||||||
|
set val [sct target]
|
||||||
|
sct send "0${axis}A$val"
|
||||||
|
hupdate /sics/${name}/status run
|
||||||
|
return setrcv
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::setrcv {controller name} {
|
||||||
|
set data [phytron::check]
|
||||||
|
if {[string first NACK $data] >= 0} {
|
||||||
|
error "Invalid command"
|
||||||
|
}
|
||||||
|
$controller queue /sics/${name}/status progress read
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc phytron::sendstatus {axis} {
|
||||||
|
sct send "0${axis}=H"
|
||||||
|
return rcvstatus
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc phytron::rcvstatus {axis controller enc} {
|
||||||
|
set status [catch {phytron::check} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct update error
|
||||||
|
clientput $error
|
||||||
|
}
|
||||||
|
if {[string first ACKN $data] >= 0} {
|
||||||
|
sct update run
|
||||||
|
$controller queue [sct] progress read
|
||||||
|
}
|
||||||
|
if {[string first ACKE $data] >= 0} {
|
||||||
|
phytron::readpos $axis $enc
|
||||||
|
return posrcv
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc phytron::statpos {axis name} {
|
||||||
|
set data [phytron::check]
|
||||||
|
set pos [string range $data 3 end]
|
||||||
|
hupdate /sics/${name}/hardposition $pos
|
||||||
|
sct send "0${axis}=I+"
|
||||||
|
return statposlim
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::statposlim {axis} {
|
||||||
|
set data [phytron::check]
|
||||||
|
if {[string first ACKE $data] >= 0} {
|
||||||
|
sct update error
|
||||||
|
clientput "Hit positive limit switch"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
sct send "0${axis}=I-"
|
||||||
|
return statneglim
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::statneglim {axis} {
|
||||||
|
set data [phytron::check]
|
||||||
|
if {[string first ACKE $data] >= 0} {
|
||||||
|
sct update error
|
||||||
|
clientput "Hit negative limit switch"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
sct send "0${axis}=E"
|
||||||
|
return statend
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::statend {axis} {
|
||||||
|
set data [phytron::check]
|
||||||
|
if {[string first ACKE $data] >= 0} {
|
||||||
|
sct update error
|
||||||
|
clientput "Electronics error"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
sct update idle
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::readspeed {axis} {
|
||||||
|
sct send "0${axis}P14R"
|
||||||
|
return rcvspeed
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::rcvspeed {} {
|
||||||
|
set data [phytron::check]
|
||||||
|
set speed [string range $data 3 end]
|
||||||
|
sct update $speed
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::writespeed {axis} {
|
||||||
|
set val [sct target]
|
||||||
|
sct send "0${axis}P14S$val"
|
||||||
|
return rcvwspeed
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc phytron::rcvwspeed {axis} {
|
||||||
|
set data [phytron::check]
|
||||||
|
if {[string first NACK $data] >= 0} {
|
||||||
|
error "Invalid command"
|
||||||
|
}
|
||||||
|
return [phytron::readspeed $axis]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc phytron::halt {controller axis} {
|
||||||
|
$controller send "0${axis}SN"
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
proc phytron::refrun {name controller axis lowlim} {
|
||||||
|
set path /sics/${name}/status
|
||||||
|
$controller send "0${axis}0-"
|
||||||
|
hupdate $path run
|
||||||
|
set motstat run
|
||||||
|
wait 3
|
||||||
|
while {[string compare $motstat run] == 0} {
|
||||||
|
$controller queue $path progress read
|
||||||
|
wait 1
|
||||||
|
set motstat [string trim [hval $path]]
|
||||||
|
}
|
||||||
|
$controller transact "0${axis}P20S$lowlim"
|
||||||
|
$controller transact "0${axis}P22S$lowlim"
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc phytron::defpos {controller axis value} {
|
||||||
|
$controller transact "0${axis}P20S$value"
|
||||||
|
$controller transact "0${axis}P22S$value"
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
proc phytron::make {name axis controller lowlim upperlim {enc 1}} {
|
||||||
|
MakeSecMotor $name
|
||||||
|
|
||||||
|
hdel /sics/${name}/hardupperlim
|
||||||
|
hdel /sics/${name}/hardlowerlim
|
||||||
|
hfactory /sics/${name}/hardupperlim plain internal float
|
||||||
|
hfactory /sics/${name}/hardlowerlim plain internal float
|
||||||
|
$name hardlowerlim $lowlim
|
||||||
|
$name softlowerlim $lowlim
|
||||||
|
$name hardupperlim $upperlim
|
||||||
|
$name softupperlim $upperlim
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/hardposition read phytron::readpos $axis $enc
|
||||||
|
hsetprop /sics/${name}/hardposition posrcv phytron::posrcv
|
||||||
|
$controller poll /sics/${name}/hardposition 60
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/hardposition write phytron::setpos $axis $name
|
||||||
|
hsetprop /sics/${name}/hardposition setrcv phytron::setrcv $controller $name
|
||||||
|
$controller write /sics/${name}/hardposition
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/status read phytron::sendstatus $axis
|
||||||
|
hsetprop /sics/${name}/status rcvstatus phytron::rcvstatus $axis $controller $enc
|
||||||
|
hsetprop /sics/${name}/status posrcv phytron::statpos $axis $name
|
||||||
|
hsetprop /sics/${name}/status statposlim phytron::statposlim $axis
|
||||||
|
hsetprop /sics/${name}/status statneglim phytron::statneglim $axis
|
||||||
|
hsetprop /sics/${name}/status statend phytron::statend $axis
|
||||||
|
$controller poll /sics/${name}/status 60
|
||||||
|
|
||||||
|
hfactory /sics/${name}/speed plain user float
|
||||||
|
hsetprop /sics/${name}/speed read "phytron::readspeed $axis"
|
||||||
|
hsetprop /sics/${name}/speed rcvspeed "phytron::rcvspeed"
|
||||||
|
hsetprop /sics/${name}/speed write "phytron::writespeed $axis"
|
||||||
|
hsetprop /sics/${name}/speed rcvwspeed "phytron::rcvwspeed $axis"
|
||||||
|
$controller poll /sics/${name}/speed 60
|
||||||
|
$controller write /sics/${name}/speed
|
||||||
|
|
||||||
|
$name makescriptfunc halt "phytron::halt $controller $axis" user
|
||||||
|
|
||||||
|
$name makescriptfunc refrun "phytron::refrun $name $controller $axis $lowlim" user
|
||||||
|
|
||||||
|
$name makescriptfunc sethardpos "phytron::defpos $controller $axis" user
|
||||||
|
hfactory /sics/${name}/sethardpos/value plain user float
|
||||||
|
|
||||||
|
hupdate /sics/${name}/status idle
|
||||||
|
$controller queue /sics/${name}/hardposition progress read
|
||||||
|
$controller queue /sics/${name}/speed progress read
|
||||||
|
}
|
||||||
|
#===============================================================================================
|
||||||
|
# At MORPHEUS there is a special table where one motor needs a brake. This requires a digital I/O
|
||||||
|
# to be disabled before driving and enabled after driving. The code below adds this feature to
|
||||||
|
# a phytron motor
|
||||||
|
#-----------------------------------------------------------------------------------------------
|
||||||
|
proc phytron::openset {out} {
|
||||||
|
sct send [format "0A%dS" $out]
|
||||||
|
return openans
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------------------------------
|
||||||
|
proc phytron::openans {axis name} {
|
||||||
|
after 100
|
||||||
|
return [phytron::setpos $axis $name]
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------------------------------
|
||||||
|
proc phytron::outsend {axis out} {
|
||||||
|
set data [phytron::check]
|
||||||
|
if {[string first ACKE $data] >= 0} {
|
||||||
|
sct update error
|
||||||
|
clientput "Electronics error"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
sct send [format "0A%dR" $out]
|
||||||
|
return outend
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------------------------------
|
||||||
|
proc phytron::outend {} {
|
||||||
|
sct update idle
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------------------------------
|
||||||
|
proc phytron::configureM2 {motor axis out} {
|
||||||
|
set path /sics/${motor}
|
||||||
|
hsetprop $path/hardposition write phytron::openset $out
|
||||||
|
hsetprop $path/hardposition openans phytron::openans $axis $motor
|
||||||
|
|
||||||
|
hsetprop $path/status statend phytron::outsend $axis $out
|
||||||
|
hsetprop $path/status outend phytron::outend
|
||||||
|
}
|
||||||
@@ -0,0 +1,177 @@
|
|||||||
|
#----------------------------------------------------
|
||||||
|
# This is a scriptcontext motor driver for the
|
||||||
|
# prehistoric Physik Instrumente DC-406, C-804 DC
|
||||||
|
# motor controller.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Scriptchains:
|
||||||
|
# - read - readreply
|
||||||
|
# - write - writerepy
|
||||||
|
# - sendstatus - statusreply - statuspos
|
||||||
|
# - speedread - readreply
|
||||||
|
# - writespeed - speedreply
|
||||||
|
# - writenull - speedreply
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2009, after the
|
||||||
|
# C original from 1998
|
||||||
|
# Made to work, Mark Koennecke, January 2011
|
||||||
|
#-----------------------------------------------------
|
||||||
|
|
||||||
|
namespace eval pimotor {}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc pimotor::read {num} {
|
||||||
|
sct send [format "%1.1dTP" $num]
|
||||||
|
return readreply
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc pimotor::readreply {} {
|
||||||
|
set result [sct result]
|
||||||
|
if {[string first ? $result] >= 0} {
|
||||||
|
error $result
|
||||||
|
}
|
||||||
|
if {[string first ERR $result] >= 0} {
|
||||||
|
error $result
|
||||||
|
}
|
||||||
|
set val [string range $result 3 end]
|
||||||
|
sct update $val
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc pimotor::write {num name} {
|
||||||
|
set ival [expr int([sct target])]
|
||||||
|
# After a stop, the motor is switched off. In order to fix this
|
||||||
|
# we switch the motor on for each drive command
|
||||||
|
sct send [format "%1.1dMN,%1.1dMA%10.10d{0}" $num $num $ival]
|
||||||
|
hupdate /sics/${name}/status run
|
||||||
|
return writereply
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc pimotor::writereply {name} {
|
||||||
|
# the DC-406 does not reply on this, so we have for sure a
|
||||||
|
# timeout here which we ignore. We do nothing else, as we
|
||||||
|
# need a little wait anyway to get the motor to start
|
||||||
|
# before starting to check status.
|
||||||
|
#----------------------------------------------------
|
||||||
|
wait 1
|
||||||
|
set con [sct controller]
|
||||||
|
hset /sics/${name}/status run
|
||||||
|
$con queue /sics/${name}/status progress read
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------
|
||||||
|
proc pimotor::sendstatus {num} {
|
||||||
|
sct send [format "%1.1dTV" $num]
|
||||||
|
return statusreply
|
||||||
|
}
|
||||||
|
#------------------------------------------------------
|
||||||
|
proc pimotor::statusreply {num} {
|
||||||
|
set result [sct result]
|
||||||
|
if {[string first ? $result] >= 0} {
|
||||||
|
sct update error
|
||||||
|
error $result
|
||||||
|
}
|
||||||
|
if {[string first ERR $result] >= 0} {
|
||||||
|
sct update error
|
||||||
|
error $result
|
||||||
|
}
|
||||||
|
set val [string trimleft [string range $result 3 13] "0-"]
|
||||||
|
set val [string trim $val]
|
||||||
|
if {[string length $val] > 1} {
|
||||||
|
set len [string length $val]
|
||||||
|
clientput "Value = $val, length = $len"
|
||||||
|
if {abs($val) > 0} {
|
||||||
|
sct update run
|
||||||
|
[sct controller] queue [sct] progress read
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
pimotor::read $num
|
||||||
|
return statuspos
|
||||||
|
}
|
||||||
|
#------------------------------------------------------
|
||||||
|
proc pimotor::statuspos {name} {
|
||||||
|
set result [sct result]
|
||||||
|
if {[string first ? $result] >= 0} {
|
||||||
|
error $result
|
||||||
|
}
|
||||||
|
if {[string first ERR $result] >= 0} {
|
||||||
|
error $result
|
||||||
|
}
|
||||||
|
set val [string range $result 3 end]
|
||||||
|
hupdate /sics/${name}/hardposition $val
|
||||||
|
sct update idle
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
proc pimotor::readspeed {num} {
|
||||||
|
sct send [format "%1.1dTY" $num]
|
||||||
|
return readreply
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc pimotor::writespeed {num} {
|
||||||
|
sct send [format "%1.1dSV%7.7d" $num [sct target]]
|
||||||
|
return speedreply
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc pimotor::speedreply {num} {
|
||||||
|
pimotor::readspeed $num
|
||||||
|
return readreply
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------
|
||||||
|
proc pimotor::writenull {controller num} {
|
||||||
|
$controller send [format "%1.1dDH{0}" $num]
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#------------------------------------------------------
|
||||||
|
proc pimotor::writeon {controller num} {
|
||||||
|
$controller send [format "%1.1dMN{0}" $num]
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#------------------------------------------------------
|
||||||
|
proc pimotor::halt {controller num} {
|
||||||
|
$controller send [format "%1.1dAB{0}" $num]
|
||||||
|
return Done
|
||||||
|
}
|
||||||
|
#------------------------------------------------------
|
||||||
|
proc pimotor::makepimotor {name num sct lowlim upperlim} {
|
||||||
|
MakeSecMotor $name
|
||||||
|
|
||||||
|
hdel /sics/${name}/hardupperlim
|
||||||
|
hdel /sics/${name}/hardlowerlim
|
||||||
|
hfactory /sics/${name}/hardupperlim plain internal float
|
||||||
|
hfactory /sics/${name}/hardlowerlim plain internal float
|
||||||
|
$name hardlowerlim $lowlim
|
||||||
|
$name softlowerlim $lowlim
|
||||||
|
$name hardupperlim $upperlim
|
||||||
|
$name softupperlim $upperlim
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/hardposition read pimotor::read $num
|
||||||
|
hsetprop /sics/${name}/hardposition readreply pimotor::readreply
|
||||||
|
$sct poll /sics/${name}/hardposition 60
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/hardposition write pimotor::write $num $name
|
||||||
|
hsetprop /sics/${name}/hardposition writereply pimotor::writereply $name
|
||||||
|
$sct write /sics/${name}/hardposition
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/status read pimotor::sendstatus $num
|
||||||
|
hsetprop /sics/${name}/status statusreply pimotor::statusreply $num
|
||||||
|
hsetprop /sics/${name}/status statuspos pimotor::statuspos $name
|
||||||
|
$sct poll /sics/${name}/status 60
|
||||||
|
|
||||||
|
hfactory /sics/${name}/speed plain user int
|
||||||
|
hsetprop /sics/${name}/speed read pimotor::readspeed $num
|
||||||
|
hsetprop /sics/${name}/speed readreply pimotor::readreply
|
||||||
|
$sct poll /sics/${name}/speed 120
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/speed write pimotor::writespeed $num
|
||||||
|
hsetprop /sics/${name}/speed speedreply pimotor::speedreply $num
|
||||||
|
$sct write /sics/${name}/speed
|
||||||
|
|
||||||
|
$name makescriptfunc halt "pimotor::halt $sct $num" user
|
||||||
|
$name makescriptfunc on "pimotor::writeon $sct $num" user
|
||||||
|
$name makescriptfunc home "pimotor::writenull $sct $num" user
|
||||||
|
|
||||||
|
hupdate /sics/${name}/status idle
|
||||||
|
$sct queue /sics/${name}/hardposition progress read
|
||||||
|
}
|
||||||
@@ -0,0 +1,66 @@
|
|||||||
|
#---------------------------------------------------------------
|
||||||
|
# This is a second generation simulation motor.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, December 2008
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc simhardset {motname newval} {
|
||||||
|
hset /sics/$motname/starttime [clock sec]
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc simhardget {motname} {
|
||||||
|
set stat [hval /sics/$motname/status]
|
||||||
|
set val [hval /sics/$motname/targetposition]
|
||||||
|
if {[string first run $stat] >= 0 \
|
||||||
|
|| [string first error $stat] >= 0 } {
|
||||||
|
return [expr $val -.777]
|
||||||
|
} else {
|
||||||
|
return $val
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc simhardfaultget {motname} {
|
||||||
|
set val [hval /sics/$motname/targetposition]
|
||||||
|
return [expr $val - .5]
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc simstatusget {motname} {
|
||||||
|
set start [hval /sics/$motname/starttime]
|
||||||
|
if {$start < 0} {
|
||||||
|
return error
|
||||||
|
}
|
||||||
|
set delay [hval /sics/$motname/delay]
|
||||||
|
if {[clock sec] > $start + $delay} {
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
return run
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc simstatusfault {motname } {
|
||||||
|
clientput "ERROR: I am feeling faulty!"
|
||||||
|
return error
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc simhalt {motname} {
|
||||||
|
hset /sics/$motname/starttime -100
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc MakeSecSim {name lower upper delay} {
|
||||||
|
MakeSecMotor $name
|
||||||
|
hfactory /sics/$name/delay plain user text
|
||||||
|
hfactory /sics/$name/starttime plain user int
|
||||||
|
hset /sics/$name/delay $delay
|
||||||
|
hdel /sics/$name/hardposition
|
||||||
|
hfactory /sics/$name/hardposition script "simhardget $name" "simhardset $name" float
|
||||||
|
# hfactory /sics/$name/hardposition script "simhardfaultget $name" "simhardset $name" float
|
||||||
|
hdel /sics/$name/status
|
||||||
|
hfactory /sics/$name/status script "simstatusget $name" "hdbReadOnly b" text
|
||||||
|
# hfactory /sics/$name/status script "simstatusfault $name" "hdbReadOnly b" text
|
||||||
|
$name makescriptfunc halt "simhalt $name" user
|
||||||
|
hupdate /sics/$name/hardupperlim $upper
|
||||||
|
hupdate /sics/$name/softupperlim $upper
|
||||||
|
hupdate /sics/$name/hardlowerlim $lower
|
||||||
|
hupdate /sics/$name/softlowerlim $lower
|
||||||
|
}
|
||||||
@@ -0,0 +1,91 @@
|
|||||||
|
#-----------------------------------------------------
|
||||||
|
# This is a simulation driver for the second
|
||||||
|
# generation histogram memory. It provides
|
||||||
|
# for a fill value which is used to initialize
|
||||||
|
# data.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, January 2010
|
||||||
|
#-----------------------------------------------------
|
||||||
|
namespace eval simhm {}
|
||||||
|
#-----------------------------------------------------
|
||||||
|
proc simhm::getcontrol {name} {
|
||||||
|
return -9999.99
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc simhm::setcontrol {name val} {
|
||||||
|
switch $val {
|
||||||
|
1000 {
|
||||||
|
hset /sics/${name}/internalstatus run
|
||||||
|
set pp [hval /sics/${name}/preset]
|
||||||
|
hset /sics/${name}/finishtime [expr $pp + [clock seconds]]
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
1001 {
|
||||||
|
hset /sics/${name}/internalstatus error
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
1002 {
|
||||||
|
hset /sics/${name}/internalstatus pause
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
1003 {
|
||||||
|
hset /sics/${name}/internalstatus run
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
1005 {
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
clientput "ERROR: bad start target $target given to control"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc simhm::getstatus {name} {
|
||||||
|
set status [string trim [hval /sics/${name}/internalstatus]]
|
||||||
|
if {[string first run $status] >= 0} {
|
||||||
|
set fin [string trim [hval /sics/${name}/finishtime]]
|
||||||
|
if {[clock seconds] > $fin} {
|
||||||
|
hset /sics/${name}/internalstatus idle
|
||||||
|
set val [string trim [hval /sics/${name}/initval]]
|
||||||
|
$name set $val
|
||||||
|
set second [string trim [hval /sics/${name}/secondbank]]
|
||||||
|
if {[string compare $second NULL] != 0} {
|
||||||
|
harray /sics/${name}/${second} init $val
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $status
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------
|
||||||
|
proc simhm::MakeSimHM {name rank {tof NULL} } {
|
||||||
|
MakeSecHM $name $rank $tof
|
||||||
|
hfactory /sics/${name}/initval plain user int
|
||||||
|
hset /sics/${name}/initval 0
|
||||||
|
|
||||||
|
hfactory /sics/${name}/finishtime plain user int
|
||||||
|
hfactory /sics/${name}/internalstatus plain user text
|
||||||
|
hupdate /sics/${name}/internalstatus idle
|
||||||
|
|
||||||
|
hdel /sics/${name}/control
|
||||||
|
hfactory /sics/${name}/control script \
|
||||||
|
"simhm::getcontrol $name" "simhm::setcontrol $name" float
|
||||||
|
hsetprop /sics/${name}/control priv user
|
||||||
|
|
||||||
|
hdel /sics/${name}/status
|
||||||
|
hfactory /sics/${name}/status script \
|
||||||
|
"simhm::getstatus $name" hdbReadOnly text
|
||||||
|
hsetprop /sics/${name}/control priv user
|
||||||
|
hupdate /sics/${name}/status idle
|
||||||
|
|
||||||
|
hfactory /sics/${name}/secondbank plain user text
|
||||||
|
hupdate /sics/${name}/secondbank NULL
|
||||||
|
}
|
||||||
|
#------------------------------------------------------
|
||||||
|
proc simhm::makeSecond {name bankname length} {
|
||||||
|
hfactory /sics/${name}/${bankname} plain user intvarar $length
|
||||||
|
hupdate /sics/${name}/secondbank $bankname
|
||||||
|
}
|
||||||
@@ -0,0 +1,152 @@
|
|||||||
|
#--------------------------------------------------------
|
||||||
|
# This is an asynchronous scriptcontext driven driver for
|
||||||
|
# the SINQ style http based histogram memory.
|
||||||
|
#
|
||||||
|
# script chains:
|
||||||
|
# -- control
|
||||||
|
# hmhttpcontrol - hmhttpreply
|
||||||
|
# -- data
|
||||||
|
# hmhttpdata - hmhttpreply
|
||||||
|
# -- status
|
||||||
|
# hmhttpstatus - hmhttpevalstatus -- hmhttpstatusdata
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, May 2009
|
||||||
|
#
|
||||||
|
# You will need to override hmhttpevalstatus to implement
|
||||||
|
# an update of the detector data
|
||||||
|
#
|
||||||
|
# Mark Koennecke, April 2010
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc hmhttpsend {url} {
|
||||||
|
sct send $url
|
||||||
|
return hmhttpreply
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc hmhttptest {data} {
|
||||||
|
if {[string first ASCERR $data] >= 0} {
|
||||||
|
error $data
|
||||||
|
}
|
||||||
|
if {[string first ERROR $data] >= 0} {
|
||||||
|
error $data
|
||||||
|
}
|
||||||
|
return $data
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc hmhttpreply {} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {hmhttptest $reply} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
clientput $data
|
||||||
|
} else {
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc hmhttpcontrol {} {
|
||||||
|
set target [sct target]
|
||||||
|
switch $target {
|
||||||
|
1000 {
|
||||||
|
set ret [hmhttpsend "/admin/startdaq.egi"]
|
||||||
|
set path [file dirname [sct]]
|
||||||
|
[sct controller] queue $path/status progress read
|
||||||
|
return $ret
|
||||||
|
}
|
||||||
|
1001 {return [hmhttpsend "/admin/stopdaq.egi"] }
|
||||||
|
1002 {return [hmhttpsend "/admin/pausedaq.egi"] }
|
||||||
|
1003 {return [hmhttpsend "/admin/continuedaq.egi"]}
|
||||||
|
1005 {
|
||||||
|
set path [file dirname [sct]]
|
||||||
|
set script [hval $path/initscript]
|
||||||
|
set confdata [eval $script]
|
||||||
|
return [hmhttpsend "post:/admin/configure.egi:$confdata"]
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
sct print "ERROR: bad start target $target given to control"
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc hmhttpdata {name} {
|
||||||
|
set len [hval /sics/${name}/datalength]
|
||||||
|
set path "/sics/${name}/data"
|
||||||
|
set com [format "node:%s:/admin/readhmdata.egi?bank=0&start=0&end=%d" $path $len]
|
||||||
|
sct send $com
|
||||||
|
return hmhttpdatareply
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc hmhttpdatareply {} {
|
||||||
|
set status [catch {hmhttpreply} txt]
|
||||||
|
if {$status == 0} {
|
||||||
|
set path [file dirname [sct]]
|
||||||
|
hdelprop $path/data geterror
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc hmhttpstatus {} {
|
||||||
|
sct send /admin/textstatus.egi
|
||||||
|
return hmhttpevalstatus
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
proc hmhttpstatusdata {} {
|
||||||
|
catch {hmhttpdatareply}
|
||||||
|
sct update idle
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc hmhttpevalstatus {name} {
|
||||||
|
set reply [sct result]
|
||||||
|
set status [catch {hmhttptest $reply} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
clientput $data
|
||||||
|
sct update error
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hdelprop [sct] geterror
|
||||||
|
set lines [split $data \n]
|
||||||
|
foreach line $lines {
|
||||||
|
set ld [split $line :]
|
||||||
|
sct [string trim [lindex $ld 0]] [string trim [lindex $ld 1]]
|
||||||
|
}
|
||||||
|
set daq [sct DAQ]
|
||||||
|
set old [hval [sct]]
|
||||||
|
if {$daq == 1} {
|
||||||
|
sct update run
|
||||||
|
[sct controller] queue [sct] progress read
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
if {[string compare $old idle] != 0} {
|
||||||
|
hmhttpdata $name
|
||||||
|
return hmhttpstatusdata
|
||||||
|
} else {
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------
|
||||||
|
proc MakeHTTPHM {name rank host initscript {tof NULL} } {
|
||||||
|
sicsdatafactory new ${name}transfer
|
||||||
|
makesctcontroller ${name}sct sinqhttp $host ${name}transfer 600 spy 007
|
||||||
|
MakeSecHM $name $rank $tof
|
||||||
|
hsetprop /sics/${name}/control write hmhttpcontrol
|
||||||
|
hsetprop /sics/${name}/control hmhttpreply hmhttpreply
|
||||||
|
${name}sct write /sics/${name}/control
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/data read hmhttpdata $name
|
||||||
|
hsetprop /sics/${name}/data hmhttpdatareply hmhttpdatareply
|
||||||
|
${name}sct poll /sics/${name}/data 120
|
||||||
|
|
||||||
|
hsetprop /sics/${name}/status read hmhttpstatus
|
||||||
|
hsetprop /sics/${name}/status hmhttpevalstatus hmhttpevalstatus $name
|
||||||
|
hsetprop /sics/${name}/status hmhttpstatusdata hmhttpstatusdata
|
||||||
|
${name}sct poll /sics/${name}/status 60
|
||||||
|
|
||||||
|
hfactory /sics/${name}/initscript plain mugger text
|
||||||
|
hset /sics/${name}/initscript $initscript
|
||||||
|
}
|
||||||
@@ -0,0 +1,100 @@
|
|||||||
|
#------------------------------------------------------
|
||||||
|
# This is some code for a standard drivable object in
|
||||||
|
# the scriptcontext system. It implements an empty
|
||||||
|
# object which throws errors when accessed. Users
|
||||||
|
# of such an object can override it to do
|
||||||
|
# something more acceptable. This object also
|
||||||
|
# provides for basic limit checking and status
|
||||||
|
# checking. It can serve as a basis for creating
|
||||||
|
# new drivable objects, for instance environment
|
||||||
|
# control devices. A possible user has as the
|
||||||
|
# first thing in a write script to set the target
|
||||||
|
# node to the desired value.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2009
|
||||||
|
#--------------------------------------------------------
|
||||||
|
|
||||||
|
namespace eval stddrive {}
|
||||||
|
|
||||||
|
proc stddrive::stdcheck {name} {
|
||||||
|
set val [sct target]
|
||||||
|
set upper [hval /sics/${name}/upperlimit]
|
||||||
|
set lower [hval /sics/${name}/lowerlimit]
|
||||||
|
if {$val < $lower || $val > $upper} {
|
||||||
|
error "$val is out of range $lower - $upper for $name"
|
||||||
|
}
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
proc stddrive::stdstatus {name} {
|
||||||
|
set test [catch {sct geterror} errortxt]
|
||||||
|
if {$test == 0} {
|
||||||
|
return fault
|
||||||
|
}
|
||||||
|
set stop [hval /sics/${name}/stop]
|
||||||
|
if {$stop == 1} {
|
||||||
|
return fault
|
||||||
|
}
|
||||||
|
set target [sct target]
|
||||||
|
set tol [hval /sics/${name}/tolerance]
|
||||||
|
set is [hval /sics/${name}]
|
||||||
|
if {abs($target - $is) < $tol} {
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
[sct controller] queue /sics/${name} progress read
|
||||||
|
return busy
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
proc stddrive::stop {name} {
|
||||||
|
hset /sics/${name}/stop 1
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------
|
||||||
|
proc stddrive::deread {} {
|
||||||
|
sct update -9999.99
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc stddrive::dewrite {name} {
|
||||||
|
# hset /sics/${name}/stop 1
|
||||||
|
error "$name is not configured, cannot drive"
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc stddrive::deconfigure {name} {
|
||||||
|
set allowed [list upperlimit lowerlimit tolerance stop]
|
||||||
|
set nodelist [split [hlist /sics/${name}] \n]
|
||||||
|
foreach node $nodelist {
|
||||||
|
if {[string length $node] < 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
if {[lsearch -exact $allowed [string trim $node]] < 0} {
|
||||||
|
clientput "Deleting $node"
|
||||||
|
hdel /sics/${name}/${node}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
hsetprop /sics/${name} read stddrive::deread
|
||||||
|
hsetprop /sics/${name} write stddrive::dewrite $name
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------
|
||||||
|
proc stddrive::makestddrive {name sicsclass sct} {
|
||||||
|
makesctdriveobj $name float user $sicsclass $sct
|
||||||
|
hfactory /sics/${name}/tolerance plain user float
|
||||||
|
hset /sics/${name}/tolerance 2.0
|
||||||
|
hfactory /sics/${name}/upperlimit plain user float
|
||||||
|
hset /sics/${name}/upperlimit 300
|
||||||
|
hfactory /sics/${name}/lowerlimit plain user float
|
||||||
|
hset /sics/${name}/lowerlimit 10
|
||||||
|
hfactory /sics/${name}/stop plain user int
|
||||||
|
hset /sics/${name}/stop 0
|
||||||
|
|
||||||
|
hsetprop /sics/${name} checklimits stddrive::stdcheck $name
|
||||||
|
hsetprop /sics/${name} checkstatus stddrive::stdstatus $name
|
||||||
|
hsetprop /sics/${name} halt stddrive::stop $name
|
||||||
|
deconfigure $name
|
||||||
|
$sct write /sics/${name}
|
||||||
|
$sct poll /sics/${name} 60
|
||||||
|
hupdate /sics/${name} -9999.99
|
||||||
|
}
|
||||||
@@ -0,0 +1,8 @@
|
|||||||
|
#!/usr/bin/pagsh.openafs
|
||||||
|
dir=$1
|
||||||
|
export KRB5CCNAME=`/bin/mktemp /tmp/sinqbckXXXXXX`
|
||||||
|
/usr/kerberos/bin/kinit -k -t $dir/kt.sinqbck sinqbck@PSI.CH
|
||||||
|
/usr/bin/aklog -c psi.ch -k PSI.CH
|
||||||
|
$dir/$2
|
||||||
|
/usr/bin/unlog
|
||||||
|
/usr/kerberos/bin/kdestroy
|
||||||
@@ -0,0 +1,317 @@
|
|||||||
|
#----------------------------------------------------------------------
|
||||||
|
# Support functions for table processing in SICS
|
||||||
|
#
|
||||||
|
# This includes a CSV processing module from someone else. See below.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2008
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
if { [info exists __tableheader] == 0 } {
|
||||||
|
set __tableheader NULL
|
||||||
|
Publish tableexe User
|
||||||
|
Publish loop User
|
||||||
|
}
|
||||||
|
#=====================================================================
|
||||||
|
# Csv tcl package version 2.0
|
||||||
|
# A tcl library to deal with CSV (comma separated value)
|
||||||
|
# files, generated and readable by some DOS/Windows programs
|
||||||
|
# Contain two functions:
|
||||||
|
# csv2list string ?separator?
|
||||||
|
# and
|
||||||
|
# list2csv list ?separator?
|
||||||
|
# which converts line from CSV file to list and vice versa.
|
||||||
|
#
|
||||||
|
# Both functions have optional "separator argument" becouse some silly
|
||||||
|
# Windows
|
||||||
|
# program might use semicomon as delimiter in COMMA separated values
|
||||||
|
# file.
|
||||||
|
#
|
||||||
|
# Copyright (c) SoftWeyr, 1997-99
|
||||||
|
# Many thanks to Robert Seeger <rseeger1@nycap.rr.com>
|
||||||
|
# for beta-testing and fixing my misprints
|
||||||
|
# This file is distributed under GNU Library Public License. Visit
|
||||||
|
# http://www.gnu.org/copyleft/gpl.html
|
||||||
|
# for details.
|
||||||
|
|
||||||
|
#
|
||||||
|
# Convert line, read from CSV file into proper TCL list
|
||||||
|
# Commas inside quoted strings are not considered list delimiters,
|
||||||
|
# Double quotes inside quoted strings are converted to single quotes
|
||||||
|
# Double quotes are stripped out and replaced with correct Tcl quoting
|
||||||
|
#
|
||||||
|
|
||||||
|
proc csv2list {str {separator ","}} {
|
||||||
|
#build a regexp>
|
||||||
|
set regexp [subst -nocommands \
|
||||||
|
{^[ \t\r\n]*("(([^"]|"")*)"|[^"$separator \t\r]*)}]
|
||||||
|
set regexp1 [subst -nocommands {$regexp[ \t\r\n]*$separator\(.*)$}]
|
||||||
|
set regexp2 [subst -nocommands {$regexp[ \t\r\n]*\$}]
|
||||||
|
set list {}
|
||||||
|
while {[regexp $regexp1 $str junk1 unquoted quoted\
|
||||||
|
junk2 str]} {
|
||||||
|
if {[string length $quoted]||$unquoted=="\"\""} {
|
||||||
|
regsub -all {""} $quoted \" unquoted
|
||||||
|
}
|
||||||
|
lappend list $unquoted
|
||||||
|
}
|
||||||
|
if {[regexp $regexp2 $str junk unquoted quoted]} {
|
||||||
|
if {[string length $quoted]||$unquoted=="\"\""} {
|
||||||
|
regsub -all {""} $quoted \" unquoted
|
||||||
|
}
|
||||||
|
lappend list $unquoted
|
||||||
|
if {[uplevel info exist csvtail]} {
|
||||||
|
uplevel set csvtail {""}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if {[uplevel info exist csvtail]} {
|
||||||
|
uplevel [list set csvtail $str]
|
||||||
|
} else {
|
||||||
|
return -code error -errorcode {CSV 1 "CSV parse error"}\
|
||||||
|
"CSV parse error: unparsed tail \"$str\""
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $list
|
||||||
|
}
|
||||||
|
|
||||||
|
proc list2csv {list {separator ","}} {
|
||||||
|
set l {}
|
||||||
|
foreach elem $list {
|
||||||
|
if {[string match {} $elem]||
|
||||||
|
[regexp {^[+-]?([0-9]+|([0-9]+\.?[0-9]*|\.[0-9]+)([eE][+-]?[0-9]+)?)$}\
|
||||||
|
$elem]} {
|
||||||
|
lappend l $elem
|
||||||
|
} else {
|
||||||
|
regsub -all {"} $elem {""} selem
|
||||||
|
lappend l "\"$selem\""
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return [join $l $separator]
|
||||||
|
}
|
||||||
|
|
||||||
|
proc csvfile {f {separator ","}} {
|
||||||
|
set csvtail ""
|
||||||
|
set list {}
|
||||||
|
set buffer {}
|
||||||
|
while {[gets $f line]>=0} {
|
||||||
|
if {[string length $csvtail]} {
|
||||||
|
set line "$csvtail\n$line"
|
||||||
|
} elseif {![string length $line]} {
|
||||||
|
lappend list {}
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
set rec [csv2list $line $separator]
|
||||||
|
set buffer [concat $buffer $rec]
|
||||||
|
if {![ string length $csvtail]} {
|
||||||
|
lappend list $buffer
|
||||||
|
set buffer {}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {[string length $csvtail]} {
|
||||||
|
return -code error -errorcode {CSV 2 "Multiline parse error"}\
|
||||||
|
"CSV file parse error"
|
||||||
|
}
|
||||||
|
return $list
|
||||||
|
}
|
||||||
|
|
||||||
|
proc csvstring {str {separator ","}} {
|
||||||
|
set csvtail ""
|
||||||
|
set list {}
|
||||||
|
set buffer {}
|
||||||
|
foreach line [split $str "\n"] {
|
||||||
|
if {[string length $csvtail]} {
|
||||||
|
set line "$csvtail\n$line"
|
||||||
|
} elseif {![string length $line]} {
|
||||||
|
lappend list {}
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
set rec [csv2list $line $separator]
|
||||||
|
set buffer [concat $buffer $rec]
|
||||||
|
if {![ string length $csvtail]} {
|
||||||
|
lappend list $buffer
|
||||||
|
set buffer {}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {[string length $cvstail]} {
|
||||||
|
return -code error -errorcode {CSV 2 "Multiline parse error"}\
|
||||||
|
"CSV string parse error"
|
||||||
|
}
|
||||||
|
return $list
|
||||||
|
}
|
||||||
|
|
||||||
|
package provide Csv 2.1
|
||||||
|
#========================================================================
|
||||||
|
# The plan here is such: operations which happen fast or immediatly are
|
||||||
|
# done at once. Count commands or anything given as command is appended
|
||||||
|
# to a list for later execution. The idea is that this contains the
|
||||||
|
# actual measuring payload of the row.
|
||||||
|
# Drivables are immediatly started.
|
||||||
|
# After processing the rows, there is a success to wait for motors to arrive
|
||||||
|
# Then the commands for later execution are run. This frees the user of the
|
||||||
|
# the necessity to have the count or whatever command as the last thing in the row
|
||||||
|
#--------------------------------------------------------------------------------
|
||||||
|
proc testinterrupt {} {
|
||||||
|
set int [getint]
|
||||||
|
if {[string first continue $int] < 0} {
|
||||||
|
error "Interrupted"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------------
|
||||||
|
proc processtablerow {line} {
|
||||||
|
global __tableheader
|
||||||
|
set parlist [csv2list $line]
|
||||||
|
for {set i 0} {$i < [llength $__tableheader]} {incr i} {
|
||||||
|
set type [lindex $__tableheader $i]
|
||||||
|
set data [lindex $parlist $i]
|
||||||
|
#--------- first process special types
|
||||||
|
switch $type {
|
||||||
|
monitor {
|
||||||
|
lappend laterExe "count monitor $data"
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
timer {
|
||||||
|
lappend laterExe "count timer $data"
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
compar {
|
||||||
|
append command [join [lrange $parlist $i end]]
|
||||||
|
lappend laterExe $command
|
||||||
|
break
|
||||||
|
}
|
||||||
|
command {
|
||||||
|
lappend laterExe $data
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
batch {
|
||||||
|
lappend laterExe "exe $data"
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------- now look for drivables
|
||||||
|
set test [sicstype $type]
|
||||||
|
if {[string compare $test DRIV] == 0} {
|
||||||
|
set status [catch {run $type $data} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $msg for $type with $data"
|
||||||
|
}
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
#------------- now look for special objects
|
||||||
|
set objtype [sicsdescriptor $type]
|
||||||
|
switch $objtype {
|
||||||
|
SicsVariable -
|
||||||
|
MulMot -
|
||||||
|
Macro {
|
||||||
|
set status [catch {eval $type $data} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $msg for $type with $data"
|
||||||
|
}
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
clientput "Skipping non recognized column $type with data $data"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
set status [catch {success} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $msg while waiting for motors to arrive"
|
||||||
|
}
|
||||||
|
testinterrupt
|
||||||
|
foreach command $laterExe {
|
||||||
|
eval $command
|
||||||
|
testinterrupt
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc tableexe {tablefile} {
|
||||||
|
global __tableheader
|
||||||
|
if {[string first NULL $__tableheader] < 0} {
|
||||||
|
error "Tableexe already running, terminated"
|
||||||
|
}
|
||||||
|
set fullfile [SplitReply [exe fullpath $tablefile]]
|
||||||
|
set in [open $fullfile r]
|
||||||
|
gets $in header
|
||||||
|
set __tableheader [csv2list $header]
|
||||||
|
while {[gets $in line] > 0} {
|
||||||
|
set status [catch {processtablerow $line} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
set int [getint]
|
||||||
|
if {[string first continue $int] < 0} {
|
||||||
|
break
|
||||||
|
} else {
|
||||||
|
clientput "ERROR: $msg while processing row"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
close $in
|
||||||
|
set __tableheader NULL
|
||||||
|
return "Done processing table"
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
proc loop args {
|
||||||
|
clientput $args
|
||||||
|
if {[llength $args] < 2} {
|
||||||
|
error \
|
||||||
|
"Usage: loop <no> <sicscommand>\n\t<no> number of repetions\n\t<sicscommand> any SICS command"
|
||||||
|
}
|
||||||
|
set len [lindex $args 0]
|
||||||
|
set command [lrange $args 1 end]
|
||||||
|
for {set i 1} {$i <= $len} {incr i} {
|
||||||
|
clientput "Repetition $i of $len"
|
||||||
|
set status [catch {eval [join $command]} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $msg while processing loop command"
|
||||||
|
}
|
||||||
|
testinterrupt
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#==============================================================================
|
||||||
|
# This is an old attempt
|
||||||
|
#=============================================================================
|
||||||
|
proc __tablescan__ args {
|
||||||
|
global __tableheader
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader monitor]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set preset [lindex $args $idx]
|
||||||
|
set mode monitor
|
||||||
|
}
|
||||||
|
set idx [lsearch $__tableheader timer]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set preset [lindex $args $idx]
|
||||||
|
set mode timer
|
||||||
|
}
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader scanvar]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set var [lindex $args $idx]
|
||||||
|
} else {
|
||||||
|
error "ERROR: No scan variable in table"
|
||||||
|
}
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader scanstart]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set start [lindex $args $idx]
|
||||||
|
} else {
|
||||||
|
error "ERROR: No scan start in table"
|
||||||
|
}
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader scanend]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set end [lindex $args $idx]
|
||||||
|
} else {
|
||||||
|
error "ERROR: No scan end in table"
|
||||||
|
}
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader scanstep]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set step [lindex $args $idx]
|
||||||
|
} else {
|
||||||
|
error "ERROR: No scan step in table"
|
||||||
|
}
|
||||||
|
|
||||||
|
set np [expr abs($end - $start)/$step]
|
||||||
|
xxxscan var $var $start $step
|
||||||
|
xxxscan run $np $mode $preset
|
||||||
|
}
|
||||||
@@ -0,0 +1,23 @@
|
|||||||
|
#------------------------------------------------------------------------
|
||||||
|
# tecs: a script to turn on and off temperature
|
||||||
|
#
|
||||||
|
# M. Zolliker, Jun 00
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
|
||||||
|
#--------- some code to do proper initialization if necessary
|
||||||
|
set ret [catch {tecs} msg]
|
||||||
|
if {$ret != 0} {
|
||||||
|
Publish tecs User
|
||||||
|
}
|
||||||
|
|
||||||
|
proc tecs { { arg1 "on"} { arg2 ""} { arg3 ""} } {
|
||||||
|
if {[string compare $arg1 "off"]==0 } {
|
||||||
|
evfactory del temperature
|
||||||
|
return "removed temperature"
|
||||||
|
} elseif {[string compare $arg1 "on"]==0 } {
|
||||||
|
evfactory new temperature tecs
|
||||||
|
return "installed temperature via TECS"
|
||||||
|
} else {
|
||||||
|
temperature $arg1 $arg2 $arg3
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -0,0 +1,348 @@
|
|||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# Functions for writing NeXus files for a triple axis spectrometer and
|
||||||
|
# configuration of the internal scan object to support this.
|
||||||
|
#
|
||||||
|
# Mark Koennecke, May 2005
|
||||||
|
# reworked to new NeXus standards, Mark Koennecke, February 2007
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
catch {sicsdatafactory new __transfer}
|
||||||
|
set __tasdata(out) ""
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc appendMotor {np motor alias} {
|
||||||
|
set val [tasSplit [$motor]]
|
||||||
|
if { [string length $val] > 0} {
|
||||||
|
__transfer putfloat 0 $val
|
||||||
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||||
|
} else {
|
||||||
|
clientput "WARNING: failed to read $motor"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc appendIfPresent {np obj alias} {
|
||||||
|
# sea_get is defined in ~/sea/tcl/remob.tcl
|
||||||
|
set status [catch {sea_get val $obj} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
return
|
||||||
|
}
|
||||||
|
if {$msg} {
|
||||||
|
__transfer putfloat 0 $val
|
||||||
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc appendFloat {np alias val} {
|
||||||
|
if {[string length $val] > 0} {
|
||||||
|
__transfer putfloat 0 $val
|
||||||
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||||
|
} else {
|
||||||
|
clientput "WARNING: failed to read $alias"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc appendCount {np value alias} {
|
||||||
|
__transfer putint 0 $value
|
||||||
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc donothing {obj userobj} {
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc xmlprepare {obj userobj} {
|
||||||
|
global __tasdata
|
||||||
|
#------- normal prepare
|
||||||
|
tasscan prepare $obj $userobj
|
||||||
|
|
||||||
|
#--------- parse out variable
|
||||||
|
set out [tasSplit [output]]
|
||||||
|
if {[string compare [string toupper $out] "UNKNOWN"]==0} {
|
||||||
|
set out ""
|
||||||
|
}
|
||||||
|
set out [string map { "=" " " "," " "} $out]
|
||||||
|
set outlist [split $out]
|
||||||
|
foreach var $outlist {
|
||||||
|
if { [string length $var] > 1} {
|
||||||
|
set ret [catch {tasSplit [$var]} msg]
|
||||||
|
if {$ret == 0} {
|
||||||
|
lappend __tasdata(out) $var
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------- build Header
|
||||||
|
append head " PNT "
|
||||||
|
set scanvars [split [tasSplit [iscan getscanvars]]]
|
||||||
|
foreach var $scanvars {
|
||||||
|
if { [string length $var] > 1} {
|
||||||
|
append head [format "%9s " [string toupper $var]]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
foreach var $__tasdata(out) {
|
||||||
|
append head [format "%9s " [string toupper $var]]
|
||||||
|
}
|
||||||
|
append head [format "%8s " M1]
|
||||||
|
append head [format "%8s " M2]
|
||||||
|
append head [format "%8s " TIME]
|
||||||
|
append head [format "%8s " CNTS]
|
||||||
|
append head [format "%8s " CTOT]
|
||||||
|
clientput $head
|
||||||
|
|
||||||
|
set __tasdata(starttime) [sicstime]
|
||||||
|
|
||||||
|
xmltaswrite $obj $userobj
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc xmlwritepoint {obj userobj np} {
|
||||||
|
global __tasdata scripthome
|
||||||
|
|
||||||
|
nxscript reopen $__tasdata(file) $scripthome/tasub.dic
|
||||||
|
|
||||||
|
append line [format " %3d" $np]
|
||||||
|
set scanvars [split [tasSplit [iscan getscanvars]]]
|
||||||
|
foreach var $scanvars {
|
||||||
|
if { [string length $var] > 1} {
|
||||||
|
set val [tasSplit [eval $var]]
|
||||||
|
append line [format "%9.4f " [tasSplit [$var]]]
|
||||||
|
appendMotor $np $var sc_$var
|
||||||
|
lappend storedvars $var
|
||||||
|
}
|
||||||
|
}
|
||||||
|
foreach var $__tasdata(out) {
|
||||||
|
append line [format "%9.4f " [tasSplit [eval $var]]]
|
||||||
|
appendMotor $np $var sc_$var
|
||||||
|
lappend storedvars $var
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
append line [format "%8d " [tasSplit [counter getmonitor 1]]]
|
||||||
|
append line [format "%8d " [tasSplit [counter getmonitor 2]]]
|
||||||
|
append line [format "%8.2f " [tasSplit [counter gettime]]]
|
||||||
|
append line [format "%8d " [tasSplit [counter getcounts]]]
|
||||||
|
clientput $line
|
||||||
|
|
||||||
|
appendCount $np [tasSplit [counter getcounts]] counts
|
||||||
|
appendCount $np [tasSplit [counter getmonitor 1]] cter_01
|
||||||
|
appendCount $np [tasSplit [counter getcounts]] cter_02
|
||||||
|
appendFloat $np motime [tasSplit [counter gettime]]
|
||||||
|
|
||||||
|
set varlist [list qh qk ql qm en ei ef a1 a2 a3 a4 a5 a6 sgu sgl]
|
||||||
|
|
||||||
|
foreach var $varlist {
|
||||||
|
if {[lsearch $storedvars $var] < 0} {
|
||||||
|
appendMotor $np $var sc_${var}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if {$np == 0} {
|
||||||
|
makeTASLinks
|
||||||
|
}
|
||||||
|
|
||||||
|
nxscript close
|
||||||
|
}
|
||||||
|
#====================== actual XML stuff ============================
|
||||||
|
proc writeUserData {} {
|
||||||
|
writeTextVar usnam user
|
||||||
|
writeTextVar usaff affiliation
|
||||||
|
writeTextVar usadd address
|
||||||
|
writeTextVar usmail email
|
||||||
|
writeTextVar lonam local
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc writeMonochromator {} {
|
||||||
|
global __tasdata
|
||||||
|
nxscript puttext mono_type "Pyrolytic Graphite"
|
||||||
|
appendMotor 0 mcv sc_mcv
|
||||||
|
nxscript putfloat mono_dd [tasSplit [tasub mono dd]]
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc writeAnalyzer {} {
|
||||||
|
global __tasdata
|
||||||
|
nxscript puttext ana_type "Pyrolytic Graphite"
|
||||||
|
nxscript putfloat ana_dd [tasSplit [tasub ana dd]]
|
||||||
|
set sa [tasSplit [tasub ss]]
|
||||||
|
if {$sa == 1} {
|
||||||
|
set az 0.
|
||||||
|
} else {
|
||||||
|
set az 180.
|
||||||
|
}
|
||||||
|
nxscript putfloat ana_az $az
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc writeDetector {} {
|
||||||
|
global __tasdata
|
||||||
|
set sa [tasSplit [tasub ana ss]]
|
||||||
|
if {$sa == 1} {
|
||||||
|
set az 0.
|
||||||
|
} else {
|
||||||
|
set az 180.
|
||||||
|
}
|
||||||
|
nxscript putfloat det_az $az
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc writeMonitor {} {
|
||||||
|
nxscript putcounter cter counter
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------
|
||||||
|
proc writeSample {} {
|
||||||
|
global __tasdata
|
||||||
|
tasscan nxdump nxscript sa
|
||||||
|
writeTextVar sanam sample
|
||||||
|
set sa [tasSplit [tasub mono ss]]
|
||||||
|
if {$sa == 1} {
|
||||||
|
set az 0.
|
||||||
|
} else {
|
||||||
|
set az 180.
|
||||||
|
}
|
||||||
|
nxscript putfloat saaz $az
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------
|
||||||
|
proc writePowderSample {} {
|
||||||
|
global __tasdata
|
||||||
|
tasscan nxdump nxscript sa
|
||||||
|
writeTextVar sanam sample
|
||||||
|
set sa [tasSplit [tasub mono ss]]
|
||||||
|
if {$sa == 1} {
|
||||||
|
set az 0.
|
||||||
|
} else {
|
||||||
|
set az 180.
|
||||||
|
}
|
||||||
|
nxscript putfloat saaz $az
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc makeTASLinks {} {
|
||||||
|
nxscript makelink dana sc_ei
|
||||||
|
nxscript makelink dana sc_ef
|
||||||
|
nxscript makelink dana sc_qh
|
||||||
|
nxscript makelink dana sc_qk
|
||||||
|
nxscript makelink dana sc_ql
|
||||||
|
nxscript makelink dana sc_en
|
||||||
|
nxscript makelink dana counts
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc makePowderLinks {} {
|
||||||
|
nxscript makelink dana sc_ei
|
||||||
|
nxscript makelink dana sc_ef
|
||||||
|
nxscript makelink dana sc_qm
|
||||||
|
nxscript makelink dana sc_en
|
||||||
|
nxscript makelink dana counts
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
proc makeScanLinks {} {
|
||||||
|
set alreadyLinked [list sc_ei sc_ef sc_qh sc_qf sc_qk sc_en sc_qm]
|
||||||
|
set nscan [tasSplit [iscan noscanvar]]
|
||||||
|
set axis 0
|
||||||
|
for {set i 0} {$i < $nscan} {incr i } {
|
||||||
|
set varpar [iscan getvarpar $i]
|
||||||
|
set l [split $varpar =]
|
||||||
|
set var [lindex $l 0]
|
||||||
|
set idx [string first . $var]
|
||||||
|
set var [string range $var [expr $idx + 1] end]
|
||||||
|
set alias [format "sc_%s" [string trim $var]]
|
||||||
|
set testalias [string trim [tasSplit [nxscript isalias $alias]]]
|
||||||
|
if {[lsearch $alreadyLinked $alias] < 0} {
|
||||||
|
if {$testalias == 1} {
|
||||||
|
nxscript makelink dana $alias
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {$axis == 0} {
|
||||||
|
set step [string trim [lindex $l 2]]
|
||||||
|
if {abs($step) > .001} {
|
||||||
|
if {$testalias == 1} {
|
||||||
|
nxscript putattribute $alias axis 1
|
||||||
|
set axis 1
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# if axis = 0 there is no alias; so we create something in here from the
|
||||||
|
# scan data in iscan
|
||||||
|
if {$axis == 0} {
|
||||||
|
set data [tasSplit [iscan getvardata 0]]
|
||||||
|
set count 0
|
||||||
|
foreach e $data {
|
||||||
|
set ar($count) [string trim $e]
|
||||||
|
incr count
|
||||||
|
}
|
||||||
|
nxscript putarray danascanvar ar [llength $data]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc xmltaswrite {obj userobj} {
|
||||||
|
global home __tasdata
|
||||||
|
|
||||||
|
set fil [string trim [tasSplit [iscan getfile]]]
|
||||||
|
nxscript createxml $fil $home/tasub.dic
|
||||||
|
set __tasdata(file) $fil
|
||||||
|
|
||||||
|
writeTextVar etitle title
|
||||||
|
nxscript puttext estart $__tasdata(starttime)
|
||||||
|
nxscript puttext eend [sicstime]
|
||||||
|
nxscript puttext edef NXmonotas
|
||||||
|
nxscript putglobal file_name $fil
|
||||||
|
nxscript putglobal file_time [sicstime]
|
||||||
|
|
||||||
|
nxscript updatedictvar NP [tasSplit [iscan np]]
|
||||||
|
nxscript updatedictvar INSTRUMENT [tasSplit [instrument]]
|
||||||
|
|
||||||
|
writeUserData
|
||||||
|
|
||||||
|
writeMonochromator
|
||||||
|
|
||||||
|
writeMonitor
|
||||||
|
|
||||||
|
writeSample
|
||||||
|
|
||||||
|
writeAnalyzer
|
||||||
|
|
||||||
|
writeDetector
|
||||||
|
|
||||||
|
|
||||||
|
nxscript close
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc xmlpowderwrite {obj userobj} {
|
||||||
|
global home __tasdata
|
||||||
|
|
||||||
|
set fil [string trim [tasSplit [iscan getfile]]]
|
||||||
|
nxscript createxml $fil $home/tasub.dic
|
||||||
|
set __tasData(file) $fil
|
||||||
|
|
||||||
|
writeTextVar etitle title
|
||||||
|
nxscript puttext estart $__tasdata(starttime)
|
||||||
|
nxscript puttext eend [sicstime]
|
||||||
|
nxscript puttext edef NXmonotas
|
||||||
|
nxscript putglobal file_name $fil
|
||||||
|
nxscript putglobal file_time [sicstime]
|
||||||
|
|
||||||
|
nxscript updatedictvar NP [tasSplit [iscan np]]
|
||||||
|
nxscript updatedictvar INSTRUMENT [tasSplit [instrument]]
|
||||||
|
|
||||||
|
writeUserData
|
||||||
|
|
||||||
|
writeMonochromator
|
||||||
|
|
||||||
|
writeMonitor
|
||||||
|
|
||||||
|
writePowderSample
|
||||||
|
|
||||||
|
writeAnalyzer
|
||||||
|
|
||||||
|
writeDetector
|
||||||
|
|
||||||
|
makePowderLinks
|
||||||
|
|
||||||
|
nxscript close
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------
|
||||||
|
proc xmlfinish {obj userobj} {
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc initxmlscan {} {
|
||||||
|
iscan configure script
|
||||||
|
iscan function writeheader donothing
|
||||||
|
iscan function prepare xmlprepare
|
||||||
|
iscan function drive tasscan drive
|
||||||
|
iscan function count tasscan count
|
||||||
|
iscan function collect tasscan collect
|
||||||
|
iscan function writepoint xmlwritepoint
|
||||||
|
iscan function finish xmlfinish
|
||||||
|
}
|
||||||
@@ -0,0 +1,83 @@
|
|||||||
|
##NXDICT-1.0
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
# NeXus dictionary file for a triple axis spectrometer following
|
||||||
|
# the instrument definition as of May 2005
|
||||||
|
#
|
||||||
|
# Do not modify this file if you do not knwo what you are doing,
|
||||||
|
# you may corrupt your data files!
|
||||||
|
#
|
||||||
|
# Mark Koennecke, May 2005
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
NP=1
|
||||||
|
INSTRUMENT=TASUB
|
||||||
|
#--------- entry level
|
||||||
|
etitle=/entry1,NXentry/SDS title -type NX_CHAR -rank 1
|
||||||
|
estart=/entry1,NXentry/SDS start_time -type DFNT_CHAR -rank 1
|
||||||
|
eend=/entry1,NXentry/SDS end_time -type DFNT_CHAR -rank 1
|
||||||
|
edef=/entry1,NXentry/SDS definition -type DFNT_CHAR -rank 1 \
|
||||||
|
-attr {URL,http://www.nexus.anl.gov/instruments/xml/NXmonotas.xml} \
|
||||||
|
-attr {version,1.0}
|
||||||
|
#---------- looser
|
||||||
|
usnam=/entry1,NXentry/user,NXuser/SDS name -type NX_CHAR -rank 1
|
||||||
|
usaff=/entry1,NXentry/user,NXuser/SDS affiliation -type NX_CHAR -rank 1
|
||||||
|
usadd=/entry1,NXentry/user,NXuser/SDS address -type NX_CHAR -rank 1
|
||||||
|
usmail=/entry1,NXentry/user,NXuser/SDS email -type NX_CHAR -rank 1
|
||||||
|
#---------- local contact
|
||||||
|
lonam=/entry1,NXentry/local_contact,NXuser/SDS name -type NX_CHAR -rank 1
|
||||||
|
#------------- sample
|
||||||
|
sanam=/entry1,NXentry/sample,NXsample/SDS name -type NX_CHAR -rank 1
|
||||||
|
sa_cell=/entry1,NXentry/sample,NXsample/SDS unit_cell -rank 1 -dim {6}
|
||||||
|
sa_norm=/entry1,NXentry/sample,NXsample/SDS plane_normal -rank 1 -dim {3}
|
||||||
|
sa_vec1=/entry1,NXentry/sample,NXsample/SDS plane_vector_1 -rank 1 -dim {3}
|
||||||
|
sa_vec2=/entry1,NXentry/sample,NXsample/SDS plane_vector_2 -rank 1 -dim {3}
|
||||||
|
sa_ub=/entry1,NXentry/sample,NXsample/SDS orientation_matrix -rank 2 \
|
||||||
|
-dim {3,3}
|
||||||
|
sapol=/entry1,NXentry/sample,NXsample/SDS polar_angle \
|
||||||
|
-rank 1 -attr {units,degree}
|
||||||
|
saa3=/entry1,NXentry/sample,NXsample/SDS rotation_angle \
|
||||||
|
-rank 1 -attr {units,degree}
|
||||||
|
sasgl=/entry1,NXentry/sample,NXsample/SDS sgl \
|
||||||
|
-rank 1 -attr {units,degree}
|
||||||
|
sasgu=/entry1,NXentry/sample,NXsample/SDS sgu \
|
||||||
|
-rank 1 -attr {units,degree}
|
||||||
|
saqh=/entry1,NXentry/sample,NXsample/SDS Qh -rank 1
|
||||||
|
saqk=/entry1,NXentry/sample,NXsample/SDS Qk -rank 1
|
||||||
|
saql=/entry1,NXentry/sample,NXsample/SDS Ql -rank 1
|
||||||
|
saqm=/entry1,NXentry/sample,NXsample/SDS Qm -rank 1
|
||||||
|
saen=/entry1,NXentry/sample,NXsample/SDS energy_transfer -rank 1 \
|
||||||
|
-attr {units,mev}
|
||||||
|
saaz=/entry1,NXentry/sample,NXsample/SDS azimuthal_angle -attr {units,degree}
|
||||||
|
#----------- monochromator
|
||||||
|
mono_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS type -type NX_CHAR -rank 1
|
||||||
|
mono_e=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS energy -rank 1 -dim {$(NP)} \
|
||||||
|
-attr {units,mev}
|
||||||
|
mono_theta=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle \
|
||||||
|
-rank 1 -dim {$(NP)} -attr {units,degree}
|
||||||
|
mono_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS d_spacing -attr {units,Angstroem}
|
||||||
|
#----------- analyzer
|
||||||
|
ana_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS type -type NX_CHAR -rank 1
|
||||||
|
ana_e=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS energy -rank 1 -dim {$(NP)} \
|
||||||
|
-attr {units,mev}
|
||||||
|
ana_theta=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle \
|
||||||
|
-rank 1 -dim {$(NP)} -attr {units\,degree}
|
||||||
|
ana_pol=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle -rank 1 -dim {$(NP)} \
|
||||||
|
-attr {units,degree}
|
||||||
|
ana_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS d_spacing -attr {units,Angstroem}
|
||||||
|
ana_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS azimuthal_angle -attr {units,degree}
|
||||||
|
#--------- detector
|
||||||
|
det_pol=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle -rank 1 -dim {$(NP)} \
|
||||||
|
-attr {units,degree}
|
||||||
|
counts=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS counts -type NX_INT32 -rank 1 -dim {$(NP)} \
|
||||||
|
-attr {units,degree} -attr {signal,1}
|
||||||
|
det_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS azimuthal_angle -attr {units,degree}
|
||||||
|
#------- monitors
|
||||||
|
cter_mode=/entry1,NXentry/control,NXmonitor/SDS mode -type NX_CHAR -rank 1 -dim {30}
|
||||||
|
cter_preset=/entry1,NXentry/control,NXmonitor/SDS preset
|
||||||
|
motime=/entry1,NXentry/control,NXmonitor/SDS time -attr {units,seconds} -rank 1 -dim {$(NP)}
|
||||||
|
mo01=/entry1,NXentry/control,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {$(NP)}
|
||||||
|
mo02=/entry1,NXentry/sample_stage,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {$(NP)}
|
||||||
|
#------- NXdata
|
||||||
|
dana=/entry1,NXentry/data,NXdata/NXVGROUP
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -0,0 +1,19 @@
|
|||||||
|
*************************** TOPSI Data File ********************************
|
||||||
|
Title = !!VAR(Title)!!
|
||||||
|
User = !!VAR(User)!!
|
||||||
|
File Creation Stardate: !!DATE!!
|
||||||
|
****************************************************************************
|
||||||
|
Monochromator Lamda = !!DRIV(lambda)!!
|
||||||
|
Monochromator A1 = !!DRIV(A1)!!
|
||||||
|
Monochromator A2 = !!DRIV(A2)!!
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
Sample STL = !!DRIV(STL)!!
|
||||||
|
Sample STU = !!DRIV(STU)!!
|
||||||
|
Sample SGL = !!DRIV(SGL)!!
|
||||||
|
Sample SGU = !!DRIV(SGU)!!
|
||||||
|
Zero STL = !!ZERO(STL)!!
|
||||||
|
Zero STU = !!ZERO(STU)!!
|
||||||
|
Zero SGL = !!ZERO(SGL)!!
|
||||||
|
Zero SGU = !!ZERO(SGU)!!
|
||||||
|
!!SCANZERO!!
|
||||||
|
**************************** DATA ******************************************
|
||||||
@@ -0,0 +1,286 @@
|
|||||||
|
# --------------------------------------------------------------------------
|
||||||
|
# Initialization script for Triple Axis Instruments using the
|
||||||
|
# Mark Lumsden UB matrix calculus
|
||||||
|
#
|
||||||
|
# Dr. Mark Koennecke, May 2005
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
# O P T I O N S
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
# simMode
|
||||||
|
# - 0 real instrument
|
||||||
|
# - 1 development simulation
|
||||||
|
# - 2 simserver at instrument
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
set simMode 1
|
||||||
|
|
||||||
|
set ts psts230.psi.ch
|
||||||
|
set mupad 0
|
||||||
|
|
||||||
|
#---------- Enable this for more startup debugging
|
||||||
|
protocol set all
|
||||||
|
|
||||||
|
#--------------- define home
|
||||||
|
if {$simMode == 1} {
|
||||||
|
set home $env(HOME)/src/workspace/sics/sim/taspub_sics
|
||||||
|
set scripthome $home
|
||||||
|
set loghome $env(HOME)/src/workspace/sics/sim/tmp
|
||||||
|
set datahome $loghome
|
||||||
|
ServerOption LoggerDir $env(HOME)/src/workspace/sics/test/samenv
|
||||||
|
} else {
|
||||||
|
set home /home/taspub
|
||||||
|
set scripthome $home/taspub_sics
|
||||||
|
set loghome $home/log
|
||||||
|
set datahome $home/data/2010
|
||||||
|
ServerOption LoggerDir $home/sea/logger
|
||||||
|
}
|
||||||
|
|
||||||
|
#ServerOption RedirectFile $loghome/stdtas
|
||||||
|
|
||||||
|
ServerOption ReadTimeOut 10
|
||||||
|
|
||||||
|
ServerOption AcceptTimeOut 10
|
||||||
|
|
||||||
|
ServerOption ReadUserPasswdTimeout 500000
|
||||||
|
|
||||||
|
ServerOption LogFileBaseName $loghome/tasplog
|
||||||
|
|
||||||
|
ServerOption ServerPort 2911
|
||||||
|
|
||||||
|
ServerOption InterruptPort 2917
|
||||||
|
|
||||||
|
ServerOption LogFileDir $loghome
|
||||||
|
|
||||||
|
ServerOption QuieckPort 2108
|
||||||
|
|
||||||
|
ServerOption statusfile $datahome/taspubstat.tcl
|
||||||
|
|
||||||
|
# Telnet Options
|
||||||
|
ServerOption TelnetPort 1301
|
||||||
|
ServerOption TelWord sicslogin
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
# U S E R S
|
||||||
|
|
||||||
|
# Here the SICS users are specified
|
||||||
|
# Syntax: SicsUser name password userRightsCode
|
||||||
|
#SicsUser Spy 007 3
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
SicsUser Spy 007 1
|
||||||
|
SicsUser Manager Manager 1
|
||||||
|
SicsUser lnsmanager lnsSICSlns 1
|
||||||
|
SicsUser user 10lns1 2
|
||||||
|
SicsUser taspuser 10lns1 2
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
# M O T O R S
|
||||||
|
|
||||||
|
if {$simMode == 0} {
|
||||||
|
|
||||||
|
MakeRS232Controller mota $ts 3002
|
||||||
|
mota replyterminator 0xd
|
||||||
|
mota timeout 1000
|
||||||
|
mota send "RMT 1"
|
||||||
|
mota send "ECHO 0"
|
||||||
|
mota send "RMT 1"
|
||||||
|
mota send "ECHO 0"
|
||||||
|
#mota debug 1
|
||||||
|
|
||||||
|
Motor A1 el734hp mota 1 # Monochromator Theta
|
||||||
|
a1 interruptmode 1
|
||||||
|
Motor A2 el734hp mota 9 # Monochromator Two-Theta
|
||||||
|
a2 interruptmode 1
|
||||||
|
Motor A3 el734hp mota 10 # Sample theta or omega
|
||||||
|
a3 interruptmode 1
|
||||||
|
Motor A4 el734hp mota 11 # Sample Two-Theta
|
||||||
|
a4 interruptmode 1
|
||||||
|
Motor MCV el734hp mota 3 # Monochromator curvature vertical
|
||||||
|
Motor SRO el734hp mota 12 # Sample table second ring
|
||||||
|
Motor MTL el734hp mota 4 # Monochromator translation lower
|
||||||
|
Motor MTU el734hp mota 5 # Monochromator Translation upper
|
||||||
|
Motor MGL el734hp mota 7 # Monochromator lower goniometer
|
||||||
|
|
||||||
|
|
||||||
|
MakeRS232Controller motb $ts 3003
|
||||||
|
motb replyterminator 0xd
|
||||||
|
motb timeout 1000
|
||||||
|
motb send "RMT 1"
|
||||||
|
motb send "ECHO 0"
|
||||||
|
motb send "RMT 1"
|
||||||
|
motb send "ECHO 0"
|
||||||
|
|
||||||
|
Motor A5 el734hp motb 5 # Analyzer Theta
|
||||||
|
a5 interruptmode 1
|
||||||
|
Motor A6 el734hp motb 9 # Analyzer Two-Theta
|
||||||
|
a6 interruptmode 1
|
||||||
|
Motor ACH el734hp motb 6 # Analyzer curvature horizontal
|
||||||
|
Motor STL el734hp motb 1 # Sample lower translation
|
||||||
|
Motor STU el734hp motb 2 # Sample upper translation
|
||||||
|
Motor ATL el734hp motb 7 # Analyzer lower translation
|
||||||
|
Motor ATU el734hp motb 8 # Analyzer upper translation
|
||||||
|
#Motor SGL SIM -17 17 -1 .0 # Monochromator upper goniometer
|
||||||
|
#Motor SGU SIM -17 17 -1 .0 # Monochromator upper goniometer
|
||||||
|
Motor SGL el734hp motb 3 # Sample lower goniometer
|
||||||
|
Motor SGU el734hp motb 4 # Sample upper goniometer
|
||||||
|
Motor AGL el734hp motb 11 # Analyzer lower goniometer
|
||||||
|
#Motor AGU SIM -30. 30. -.1 2. # Analyzer upper goniometer
|
||||||
|
#Motor MSC SIM -30. 30. -.1 2. # Monochromator changer
|
||||||
|
#Motor ASC SIM -30. 30. -.1 2. # Analyzer changer
|
||||||
|
#Motor CSC SIM -30. 30. -.1 2. # Collimator changer
|
||||||
|
mcv precision .1
|
||||||
|
} else {
|
||||||
|
Motor A1 sim -86.7 6.1 -.1 .1 # Monochromator Theta
|
||||||
|
Motor A2 sim -128.5 -21.65 -.1 .1 # Monochromator Two-Theta
|
||||||
|
Motor A3 sim -179 170 -.1 .1 # Sample theta or omega
|
||||||
|
Motor A4 sim -135 137.9 -.1 .1 # Sample Two-Theta
|
||||||
|
Motor A5 sim -103 103 -.1 .1 # Analyzer Theta
|
||||||
|
Motor A6 sim -138 118 -.1 .1 # Analyzer Two-Theta
|
||||||
|
Motor MCV sim -9 124 -.1 .1 # Monochromator curvature vertical
|
||||||
|
Motor SRO sim -180 351 -.1 .1 # Sample table second ring
|
||||||
|
Motor ACH sim -.5 11 -.1 .1 # Analyzer curvature horizontal
|
||||||
|
Motor MTL sim -17 17 -.1 .1 # Monochromator translation lower
|
||||||
|
Motor MTU sim -17 17 -.1 .1 # Monochromator Translation upper
|
||||||
|
Motor SGL sim -19 19 -1. 0 # Sample lower translation
|
||||||
|
Motor SGU SIM -30. 30. -.1 2. # Sample upper translation
|
||||||
|
Motor ATL sim -17 17 -.1 .1 # Analyzer lower translation
|
||||||
|
Motor ATU sim -17 17 -.1 .1 # Analyzer upper translation
|
||||||
|
Motor MGL sim -10 10 -.1 .1 # Monochromator lower goniometer
|
||||||
|
Motor SGL sim -16 16 -.1 .1 # Sample lower goniometer
|
||||||
|
Motor SGU sim -16 16 -.1 .1 # Sample upper goniometer
|
||||||
|
Motor AGL sim -10 10 -.1 .1 # Analyzer lower goniometer
|
||||||
|
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
# C U R R E N T S
|
||||||
|
Motor I1 sim -2 2 -0.1 0.1
|
||||||
|
Motor I2 sim -2 2 -0.1 0.1
|
||||||
|
Motor I3 sim -2 2 -0.1 0.1
|
||||||
|
Motor I4 sim -2 2 -0.1 0.1
|
||||||
|
Motor I5 sim -2 2 -0.1 0.1
|
||||||
|
Motor I6 sim -2 2 -0.1 0.1
|
||||||
|
Motor I7 sim -2 2 -0.1 0.1
|
||||||
|
Motor I8 sim -2 2 -0.1 0.1
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
#--------- script for saving motor parameters
|
||||||
|
Publish savemotorpar Mugger
|
||||||
|
proc savemotorpar {dir} {
|
||||||
|
set mot(controllerlist) [list mota motb]
|
||||||
|
set mot(mota) [list 1 9 10 11 3 12 4 5 7]
|
||||||
|
set mot(motb) [list 5 9 6 1 2 7 8 3 4 11]
|
||||||
|
savemotorarray mot $dir
|
||||||
|
clientput "Done saving motor parameters"
|
||||||
|
}
|
||||||
|
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
# C O U N T E R
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
if {$simMode == 0} {
|
||||||
|
MakeCounter counter el737hp $ts 3004
|
||||||
|
} else {
|
||||||
|
MakeCounter counter sim -1.
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
VarMake instrument Text Mugger
|
||||||
|
instrument TASPUB
|
||||||
|
instrument lock
|
||||||
|
|
||||||
|
VarMake title Text User
|
||||||
|
VarMake user Text User
|
||||||
|
VarMake affiliation Text User
|
||||||
|
VarMake address Text User
|
||||||
|
VarMake email Text User
|
||||||
|
VarMake lastscancommand Text User
|
||||||
|
VarMake output Text User
|
||||||
|
VarMake local Text User
|
||||||
|
VarMake sample Text User
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
# I N S T A L L M U P A D
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
if {$mupad == 1} {
|
||||||
|
source $scripthome/mupad.tcl
|
||||||
|
# new mupad commands by M.Z.
|
||||||
|
set mudata(sim) 0
|
||||||
|
source $scripthome/muco.tcl
|
||||||
|
source $scripthome/stddrive.tcl
|
||||||
|
source $scripthome/slsecho.tcl
|
||||||
|
if {$simMode == 0} {
|
||||||
|
makesctcontroller slssct slsecho taspmagnet:5001
|
||||||
|
slsecho::makeslsecho i1 0 slssct
|
||||||
|
slsecho::makeslsecho i2 1 slssct
|
||||||
|
slsecho::makeslsecho i3 2 slssct
|
||||||
|
slsecho::makeslsecho i4 3 slssct
|
||||||
|
slsecho::makeslsecho i5 4 slssct
|
||||||
|
slsecho::makeslsecho i6 5 slssct
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
# Polarisation file
|
||||||
|
VarMake polfile Text User
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# Datafile generation variables
|
||||||
|
VarMake SicsDataPath Text Mugger
|
||||||
|
SicsDataPath "$datahome/"
|
||||||
|
sicsdatapath lock
|
||||||
|
VarMake SicsDataPrefix Text Mugger
|
||||||
|
SicsDataPrefix taspub
|
||||||
|
SicsDataPrefix lock
|
||||||
|
VarMake SicsDataPostFix Text Mugger
|
||||||
|
SicsDataPostFix ".xml"
|
||||||
|
#SicsDataPostFix ".scn"
|
||||||
|
SicsDataPostFix lock
|
||||||
|
MakeDataNumber SicsDataNumber "$datahome/DataNumber"
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
# Collimation etc. parameters
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
VarMake alf1 Float User
|
||||||
|
VarMake alf2 Float User
|
||||||
|
VarMake alf3 Float User
|
||||||
|
VarMake alf4 Float User
|
||||||
|
VarMake bet1 Float User
|
||||||
|
VarMake bet2 Float User
|
||||||
|
VarMake bet3 Float User
|
||||||
|
VarMake bet4 Float User
|
||||||
|
VarMake ETAM Float User
|
||||||
|
VarMake ETAS Float User
|
||||||
|
VarMake ETAA Float User
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
# A helper variable for the status display
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
VarMake scaninfo text Internal
|
||||||
|
scaninfo "0,Unknown,1.0,.1"
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
# I N S T A L L S P E C I A L T A S C O M M A N D S
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
MakeTasUB tasub
|
||||||
|
#--------------------------- TAS scan command
|
||||||
|
MakeScanCommand iscan counter tas.hdd recover.bin
|
||||||
|
MakePeakCenter iscan
|
||||||
|
MakeTasScan iscan tasub
|
||||||
|
#-------------------------- new exe manager
|
||||||
|
definealias do exe
|
||||||
|
alias batchroot exe batchpath
|
||||||
|
#-------------------------- normal drive command
|
||||||
|
MakeDrive
|
||||||
|
#-------------------------- for NeXus
|
||||||
|
MakeNXScript
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
# I N S T A L L T A S U B S C R I P T E D C O M M A N D S
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source $scripthome/taspubcom.tcl
|
||||||
|
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
# stuff for sea
|
||||||
|
|
||||||
|
if {$simMode == 0} {
|
||||||
|
definealias tem temperature
|
||||||
|
source $home/sea/tcl/remob.tcl
|
||||||
|
connect_sea
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# SPS to look at guide field
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
MakeSPS sps $ts 3006 10
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
restore
|
||||||
|
|
||||||
|
sicscron 10 backupCron $datahome/statusHistory
|
||||||
@@ -0,0 +1,47 @@
|
|||||||
|
#---------------------------------------------------------------------------
|
||||||
|
# The triple axis people love to have the command set emulate the command
|
||||||
|
# set of TASMAD as closely as possible. This is implemented through
|
||||||
|
# some scripting. This version is for the new syntax to be used with the
|
||||||
|
# new UB matrix calculaus for triple axis.
|
||||||
|
#
|
||||||
|
# Mark Koennecke, May 2005
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
|
||||||
|
proc SplitReply { text } {
|
||||||
|
set l [split $text =]
|
||||||
|
return [string trim [lindex $l 1]]
|
||||||
|
}
|
||||||
|
|
||||||
|
source $scripthome/nxtas.tcl
|
||||||
|
source $scripthome/nxsupport.tcl
|
||||||
|
source $scripthome/tasscript.tcl
|
||||||
|
|
||||||
|
initxmlscan
|
||||||
|
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc wwwsics {} {
|
||||||
|
append result "<table BORDER=2>\n"
|
||||||
|
append result "<tr><th>User</th> <td>" [tasSplit [user]] "</td></tr>\n"
|
||||||
|
append result "<tr><th>Title</th> <td>"
|
||||||
|
append result [tasSplit [title]] "</td></tr>\n"
|
||||||
|
append result "<tr><th>Status</th> <td>"
|
||||||
|
append result [tasSplit [status]] "</td></tr>\n"
|
||||||
|
append result "<tr><th>Last Scan Command</th> <td>"
|
||||||
|
append result [tasSplit [lastcommand]] "</td></tr>\n"
|
||||||
|
append result "<tr><th>A1</td><td>"
|
||||||
|
append result [tasSplit [a1]] "</td><th>A2</th><td>"
|
||||||
|
append result [tasSplit [a2]] "</td></tr>\n"
|
||||||
|
append result "<tr><th>A3</td><td>"
|
||||||
|
append result [tasSplit [a3]] "</td><th>A4</th><td>"
|
||||||
|
append result [tasSplit [a4]] "</td></tr>\n"
|
||||||
|
append result "<tr><th>A5</td><td>"
|
||||||
|
append result [tasSplit [a5]] "</td><th>A6</th><td>"
|
||||||
|
append result [tasSplit [a6]] "</td></tr>\n"
|
||||||
|
append result "<tr><th>Ki</th><td>" [tasSplit [ki]] "</td>"
|
||||||
|
append result "<th>Kf</th><td>" [tasSplit [kf]] "</td>"
|
||||||
|
append result "<th>En</th><td>" [tasSplit [en]] "</td></tr>\n"
|
||||||
|
append result "<tr><th>Qh</th><td>" [tasSplit [qh]] "</td>"
|
||||||
|
append result "<th>Qk</th><td>" [tasSplit [qk]] "</td>"
|
||||||
|
append result "<th>Ql</th><td>" [tasSplit [ql]] "</td></tr>\n"
|
||||||
|
append result "</table>\n"
|
||||||
|
}
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,138 @@
|
|||||||
|
##NXDICT-1.0
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
# NeXus dictionary file for a triple axis spectrometer following
|
||||||
|
# the instrument definition as of May 2005
|
||||||
|
#
|
||||||
|
# Do not modify this file if you do not knwo what you are doing,
|
||||||
|
# you may corrupt your data files!
|
||||||
|
#
|
||||||
|
# Mark Koennecke, May 2005
|
||||||
|
# Mark Koennecke, August 2006
|
||||||
|
# Change to new NeXus standards, Mark Koennecke, February 2007
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
NP=1
|
||||||
|
INSTRUMENT=TASPUB
|
||||||
|
#--------- entry level
|
||||||
|
etitle=/entry1,NXentry/SDS title -type NX_CHAR -rank 1
|
||||||
|
instrument=/entry1,NXentry/SDS instrument -type NX_CHAR -rank 1
|
||||||
|
escancommand=/entry1,NXentry/SDS scancommand -type NX_CHAR -rank 1
|
||||||
|
escanvars=/entry1,NXentry/SDS scanvars -type NX_CHAR -rank 1
|
||||||
|
estart=/entry1,NXentry/SDS start_time -type DFNT_CHAR -rank 1
|
||||||
|
eend=/entry1,NXentry/SDS end_time -type DFNT_CHAR -rank 1
|
||||||
|
edef=/entry1,NXentry/SDS definition -type DFNT_CHAR -rank 1 \
|
||||||
|
-attr {URL,http://www.nexus.anl.gov/instruments/xml/NXmonotas.xml} \
|
||||||
|
-attr {version,1.0}
|
||||||
|
#---------- looser
|
||||||
|
usnam=/entry1,NXentry/user,NXuser/SDS name -type NX_CHAR -rank 1
|
||||||
|
usaff=/entry1,NXentry/user,NXuser/SDS affiliation -type NX_CHAR -rank 1
|
||||||
|
usadd=/entry1,NXentry/user,NXuser/SDS address -type NX_CHAR -rank 1
|
||||||
|
usmail=/entry1,NXentry/user,NXuser/SDS email -type NX_CHAR -rank 1
|
||||||
|
#---------- local contact
|
||||||
|
lonam=/entry1,NXentry/local_contact,NXuser/SDS name -type NX_CHAR -rank 1
|
||||||
|
#------------- sample
|
||||||
|
sa_temperature=/entry1,NXentry/sample,NXsample/SDS temperature \
|
||||||
|
-attr {units,K} -rank 1 -dim {-1}
|
||||||
|
sc_tt=/entry1,NXentry/sample,NXsample/SDS temperature \
|
||||||
|
-attr {units,K} -rank 1 -dim {-1}
|
||||||
|
sa_field=/entry1,NXentry/sample,NXsample/SDS magnetic_field \
|
||||||
|
-attr {units,Tesla} -rank 1 -dim {-1}
|
||||||
|
sc_temperature=/entry1,NXentry/sample,NXsample/SDS temperature \
|
||||||
|
-attr {units,K} -rank 1 -dim {-1}
|
||||||
|
sc_te=/entry1,NXentry/sample,NXsample/SDS temperature \
|
||||||
|
-attr {units,K} -rank 1 -dim {-1}
|
||||||
|
sc_field=/entry1,NXentry/sample,NXsample/SDS magnetic_field \
|
||||||
|
-attr {units,Tesla} -rank 1 -dim {-1}
|
||||||
|
sc_mf=/entry1,NXentry/sample,NXsample/SDS magnetic_field \
|
||||||
|
-attr {units,Tesla} -rank 1 -dim {-1}
|
||||||
|
sanam=/entry1,NXentry/sample,NXsample/SDS name -type NX_CHAR -rank 1
|
||||||
|
sa_cell=/entry1,NXentry/sample,NXsample/SDS unit_cell -rank 1 -dim {6}
|
||||||
|
sa_norm=/entry1,NXentry/sample,NXsample/SDS plane_normal -rank 1 -dim {3}
|
||||||
|
sa_vec1=/entry1,NXentry/sample,NXsample/SDS plane_vector_1 -rank 1 -dim {9}
|
||||||
|
sa_vec2=/entry1,NXentry/sample,NXsample/SDS plane_vector_2 -rank 1 -dim {9}
|
||||||
|
sa_ub=/entry1,NXentry/sample,NXsample/SDS orientation_matrix -rank 2 \
|
||||||
|
-dim {3,3}
|
||||||
|
sc_a2=/entry1,NXentry/sample,NXsample/SDS polar_angle \
|
||||||
|
-rank 1 -attr {units,degree} -dim {-1}
|
||||||
|
sc_a3=/entry1,NXentry/sample,NXsample/SDS rotation_angle \
|
||||||
|
-rank 1 -attr {units,degree} -dim {-1}
|
||||||
|
sc_sgl=/entry1,NXentry/sample,NXsample/SDS sgl \
|
||||||
|
-rank 1 -attr {units,degree} -dim {-1}
|
||||||
|
sc_sgu=/entry1,NXentry/sample,NXsample/SDS sgu \
|
||||||
|
-rank 1 -attr {units,degree} -dim {-1}
|
||||||
|
2tm_zero=/entry1,NXentry/sample,NXsample/SDS polar_angle_zero \
|
||||||
|
-rank 1 -attr {units,degree}
|
||||||
|
om_zero=/entry1,NXentry/sample,NXsample/SDS rotation_angle_zero \
|
||||||
|
-rank 1 -attr {units,degree}
|
||||||
|
sgl_zero=/entry1,NXentry/sample,NXsample/SDS sgl_zero \
|
||||||
|
-rank 1 -attr {units,degree}
|
||||||
|
sgu_zero=/entry1,NXentry/sample,NXsample/SDS sgu_zero \
|
||||||
|
-rank 1 -attr {units,degree}
|
||||||
|
sc_qh=/entry1,NXentry/sample,NXsample/SDS Qh -rank 1 -dim {-1}
|
||||||
|
sc_qk=/entry1,NXentry/sample,NXsample/SDS Qk -rank 1 -dim {-1}
|
||||||
|
sc_ql=/entry1,NXentry/sample,NXsample/SDS Ql -rank 1 -dim {-1}
|
||||||
|
sc_qm=/entry1,NXentry/sample,NXsample/SDS Qm -rank 1 -dim {-1}
|
||||||
|
sc_en=/entry1,NXentry/sample,NXsample/SDS energy_transfer -rank 1 \
|
||||||
|
-attr {units,mev} -dim {-1}
|
||||||
|
saaz=/entry1,NXentry/sample,NXsample/SDS azimuthal_angle -attr {units,degree}
|
||||||
|
sc_tu=/entry1,NXentry/sample,NXsample/SDS x \
|
||||||
|
-rank 1 -attr {units,degree} -dim {-1}
|
||||||
|
sc_tl=/entry1,NXentry/sample,NXsample/SDS y \
|
||||||
|
-rank 1 -attr {units,degree} -dim {-1}
|
||||||
|
#----------- monochromator
|
||||||
|
mono_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS type -type NX_CHAR -rank 1
|
||||||
|
sc_ei=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS energy -rank 1 -dim {-1} \
|
||||||
|
-attr {units,mev} -dim {-1}
|
||||||
|
sc_a1=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle \
|
||||||
|
-rank 1 -dim {-1} -attr {units,degree} -dim {-1}
|
||||||
|
omm_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle_zero \
|
||||||
|
-rank 1 -dim {-1} -attr {units,degree}
|
||||||
|
mono_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS d_spacing -attr {units,Angstroem}
|
||||||
|
sc_mcv=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS curvature \
|
||||||
|
-rank 1 -dim {-1} -attr {units,degree}
|
||||||
|
sc_cum=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS curvature \
|
||||||
|
-rank 1 -dim {-1} -attr {units,degree} -dim {-1}
|
||||||
|
#----------- analyzer
|
||||||
|
ana_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS type -type NX_CHAR -rank 1
|
||||||
|
sc_ef=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS energy -rank 1 -dim {-1} \
|
||||||
|
-attr {units,mev}
|
||||||
|
sc_a5=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle \
|
||||||
|
-rank 1 -dim {-1} -attr {units,degree}
|
||||||
|
a5_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle_zero \
|
||||||
|
-attr {units,degree}
|
||||||
|
sc_a4=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle -rank 1 -dim {-1} \
|
||||||
|
-attr {units,degree}
|
||||||
|
2t_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle_zero -attr {units,degree}
|
||||||
|
ana_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS d_spacing -attr {units,Angstroem}
|
||||||
|
ana_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS azimuthal_angle -attr {units,degree}
|
||||||
|
sdistance=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS distance -attr {units,mm}
|
||||||
|
#--------- detector
|
||||||
|
set winno 1
|
||||||
|
sc_a6=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle -rank 1 -dim {-1} \
|
||||||
|
-attr {units,degree}
|
||||||
|
2ta_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle_zero -attr {units,degree}
|
||||||
|
counts=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS data -type NX_INT32 \
|
||||||
|
-rank 1 -dim {-1} -attr {signal,1}
|
||||||
|
det_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS azimuthal_angle -attr {units,degree}
|
||||||
|
adistance=/entry1,NXentry/$(INSTRUMENT),NXinstrument/adetector,NXcrystal/SDS distance -attr {units,mm}
|
||||||
|
#------- monitors
|
||||||
|
cter_mode=/entry1,NXentry/control,NXmonitor/SDS mode -type NX_CHAR -rank 1 -dim {30}
|
||||||
|
cter_preset=/entry1,NXentry/control,NXmonitor/SDS preset
|
||||||
|
motime=/entry1,NXentry/control,NXmonitor/SDS time -attr {units,seconds} -rank 1 -dim {-1}
|
||||||
|
cter_01=/entry1,NXentry/control,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {-1}
|
||||||
|
cter_02=/entry1,NXentry/aux_detector,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {-1}
|
||||||
|
#------- NXdata
|
||||||
|
dana=/entry1,NXentry/data,NXdata/NXVGROUP
|
||||||
|
emotor_a1=/entry1,NXentry/data,NXdata/SDS a1 \
|
||||||
|
-rank 1 -dim {-1} -attr {units,degree}
|
||||||
|
emotor_a2=/entry1,NXentry/data,NXdata/SDS a2 \
|
||||||
|
-rank 1 -dim {-1} -attr {units,degree}
|
||||||
|
emotor_a3=/entry1,NXentry/data,NXdata/SDS a3 \
|
||||||
|
-rank 1 -dim {-1} -attr {units,degree}
|
||||||
|
emotor_a4=/entry1,NXentry/data,NXdata/SDS a4 -rank 1 -dim {-1} \
|
||||||
|
-attr {units,degree}
|
||||||
|
emotor_a5=/entry1,NXentry/data,NXdata/SDS a5 -rank 1 -dim {-1} \
|
||||||
|
-attr {units,degree}
|
||||||
|
emotor_a6=/entry1,NXentry/data,NXdata/SDS a6 -rank 1 -dim {-1} \
|
||||||
|
-attr {units,degree}
|
||||||
|
danascanvar=/entry1,NXentry/data,NXdata/SDS scanvar \
|
||||||
|
-type NX_FLOAT32 -attr {axis,1} -rank 1 -dim {-1}
|
||||||
@@ -21,30 +21,23 @@ fileeval $cfPath(motors)/motor_configuration.tcl
|
|||||||
fileeval $cfPath(motors)/spin_galil.tcl
|
fileeval $cfPath(motors)/spin_galil.tcl
|
||||||
|
|
||||||
fileeval $cfPath(motors)/positmotor_configuration.tcl
|
fileeval $cfPath(motors)/positmotor_configuration.tcl
|
||||||
#fileeval $cfPath(velsel)/velsel.tcl
|
|
||||||
#fileeval $cfPath(parameters)/parameters.tcl
|
|
||||||
fileeval $cfPath(plc)/plc.tcl
|
fileeval $cfPath(plc)/plc.tcl
|
||||||
fileeval $cfPath(optics)/optics.tcl
|
fileeval $cfPath(optics)/optics.tcl
|
||||||
fileeval $cfPath(counter)/counter.tcl
|
fileeval $cfPath(counter)/counter.tcl
|
||||||
#fileeval $cfPath(environment)/temperature/sct_lakeshore_340.tcl
|
|
||||||
#fileeval $cfPath(environment)/temperature/sct_lakeshore_336.tcl
|
|
||||||
fileeval $cfPath(hmm)/hmm_configuration.tcl
|
fileeval $cfPath(hmm)/hmm_configuration.tcl
|
||||||
fileeval $cfPath(nexus)/nxscripts.tcl
|
fileeval $cfPath(nexus)/nxscripts.tcl
|
||||||
#fileeval $cfPath(hmm)/detector.tcl
|
|
||||||
fileeval $cfPath(scan)/scan.tcl
|
fileeval $cfPath(scan)/scan.tcl
|
||||||
fileeval $cfPath(commands)/commands.tcl
|
fileeval $cfPath(commands)/commands.tcl
|
||||||
fileeval $cfPath(anticollider)/anticollider.tcl
|
fileeval $cfPath(anticollider)/anticollider.tcl
|
||||||
#fileeval $cfPath(environment)/temperature/sct_julabo_lh45.tcl
|
fileeval $cfPath(tasmad)/taspub_sics/tasscript.tcl
|
||||||
#fileeval $cfPath(environment)/temperature/sct_qlink.tcl
|
|
||||||
#fileeval $cfPath(environment)/magneticField/sct_oxford_ips.tcl
|
|
||||||
#fileeval $cfPath(environment)/environment.tcl
|
|
||||||
#fileeval $cfPath(environment)/sct_mcr500_rheometer.tcl
|
|
||||||
#fileeval $cfPath(environment)/sct_protek_common.tcl
|
|
||||||
source gumxml.tcl
|
source gumxml.tcl
|
||||||
|
|
||||||
::utility::mkVar ::anticollider::protect_detector text manager protect_detector false detector true false
|
::utility::mkVar ::anticollider::protect_detector text manager protect_detector false detector true false
|
||||||
::anticollider::protect_detector "true"
|
::anticollider::protect_detector "true"
|
||||||
|
|
||||||
|
# init for the tasUB
|
||||||
|
MakeTasUB tasub m1 m2 mvfocus mhfocus s1 s2 sgu sgl a1 a2 avfocus ahfocus
|
||||||
|
|
||||||
server_init
|
server_init
|
||||||
###########################################
|
###########################################
|
||||||
# WARNING: Do not add any code below server_init, if you do SICS may fail to initialise properly.
|
# WARNING: Do not add any code below server_init, if you do SICS may fail to initialise properly.
|
||||||
|
|||||||
Reference in New Issue
Block a user