add Pelican
r3112 | jgn | 2011-04-20 12:44:37 +1000 (Wed, 20 Apr 2011) | 1 line
This commit is contained in:
Jing Chen
committed by
Douglas Clowes
Douglas Clowes
parent
baf6961a82
commit
506a265815
@@ -7,85 +7,6 @@ namespace eval motor {
|
||||
variable is_homing_list ""
|
||||
}
|
||||
|
||||
#namespace eval sample {
|
||||
# command select {int=0:8 sampid} {
|
||||
# SampleNum $sampid
|
||||
# }
|
||||
#}
|
||||
|
||||
|
||||
#namespace eval beamstops {
|
||||
# command selbsn {int=1,2,3,4,5,6 bs} {
|
||||
# selbs $bs "UNDEF" "UNDEF"
|
||||
# }
|
||||
# command selbsxz {int=1,2,3,4,5,6 bs float bx float bz} {
|
||||
# selbs $bs $bx $bz
|
||||
# }
|
||||
#}
|
||||
|
||||
#namespace eval optics {
|
||||
# VarMake ::optics::select::section text user
|
||||
# VarMake ::optics::polarizer::in text user
|
||||
# VarMake ::optics::lens::selection text user
|
||||
|
||||
# command rotary_attenuator {int=0,15,45,90,180 angle} {
|
||||
# drive att $angle
|
||||
# }
|
||||
|
||||
# command entrance_aperture {
|
||||
# int=0,45,90,135,180,270 angle
|
||||
# } {
|
||||
# drive srce $angle
|
||||
# }
|
||||
|
||||
# TODO Do we need this
|
||||
# command sample_aperture {
|
||||
# int=25,50 size
|
||||
# text=circ,squ,open,rect shape
|
||||
# } {
|
||||
# SApXmm $size
|
||||
# SApZmm $size
|
||||
# SApShape $shape
|
||||
# }
|
||||
|
||||
##############################
|
||||
##
|
||||
# @brief The "guide" command uses a lookup table to setup the collimation system
|
||||
# @param row, selects a row from the guide configuration table
|
||||
#
|
||||
# eg\n
|
||||
# guide ga
|
||||
# command guide "
|
||||
# text=[join [array names ::optics::guide_configuration] , ] configuration
|
||||
# " {
|
||||
#
|
||||
# variable guide_configuration
|
||||
# variable guide_configuration_columns
|
||||
#
|
||||
# if [ catch {
|
||||
#
|
||||
# foreach {compselection position} $guide_configuration($configuration) {
|
||||
# foreach el $compselection guide $guide_configuration_columns {
|
||||
# lappend to_config $guide
|
||||
# lappend to_config [set ::optics::${guide}_map($el)]
|
||||
# }
|
||||
# ::optics::guide -set feedback status BUSY
|
||||
# set msg [eval "drive $to_config"]
|
||||
# EApPosY $position
|
||||
# }
|
||||
# GuideConfig $configuration
|
||||
# } message ] {
|
||||
# ::optics::guide -set feedback status IDLE
|
||||
# if {$::errorCode=="NONE"} {return $message}
|
||||
# return -code error $message
|
||||
# }
|
||||
# ::optics::guide -set feedback status IDLE
|
||||
# }
|
||||
# ::optics::guide -addfb text status
|
||||
# ::optics::guide -set feedback status IDLE
|
||||
#}
|
||||
|
||||
|
||||
proc ::commands::isc_initialize {} {
|
||||
::commands::ic_initialize
|
||||
}
|
||||
|
||||
@@ -10,9 +10,6 @@ proc ::histogram_memory::init_OAT_TABLE {} {
|
||||
proc ::histogram_memory::pre_count {} {}
|
||||
proc ::histogram_memory::post_count {} {}
|
||||
proc ::histogram_memory::isc_initialize {} {
|
||||
# Instrument specific X and Y dimension names
|
||||
#variable INST_NXC "oat_nxc_eff"
|
||||
#variable INST_NYC "oat_nyc_eff"
|
||||
|
||||
if [ catch {
|
||||
::histogram_memory::init_hmm_objs
|
||||
|
||||
@@ -1,77 +0,0 @@
|
||||
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
|
||||
@@ -1,112 +0,0 @@
|
||||
#--------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,524 +0,0 @@
|
||||
#--------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,32 +0,0 @@
|
||||
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
|
||||
}
|
||||
@@ -1,29 +0,0 @@
|
||||
#--------------------------------------------
|
||||
# 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"
|
||||
}
|
||||
}
|
||||
@@ -1,169 +0,0 @@
|
||||
#------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1 +0,0 @@
|
||||
gdb -d /afs/psi.ch/user/k/koennecke/src/workspace/sics -d /afs/psi.ch/user/k/koennecke/src/workspace/sics/psi SICServer $*
|
||||
@@ -1,357 +0,0 @@
|
||||
#---------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
}
|
||||
@@ -1,488 +0,0 @@
|
||||
#--------------------------------------------------------
|
||||
# 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
|
||||
|
||||
}
|
||||
@@ -1,321 +0,0 @@
|
||||
#-----------------------------------------------------
|
||||
# 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
|
||||
|
||||
}
|
||||
@@ -1,97 +0,0 @@
|
||||
#-------------------------------------------------------------
|
||||
# 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.
@@ -1,944 +0,0 @@
|
||||
#-----------------------------------------------------------------------
|
||||
# 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.
@@ -1,82 +0,0 @@
|
||||
#---------------------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,126 +0,0 @@
|
||||
#===========================================================================
|
||||
# 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
|
||||
}
|
||||
@@ -1,311 +0,0 @@
|
||||
#------------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,177 +0,0 @@
|
||||
#----------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,66 +0,0 @@
|
||||
#---------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,91 +0,0 @@
|
||||
#-----------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,152 +0,0 @@
|
||||
#--------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,100 +0,0 @@
|
||||
#------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,8 +0,0 @@
|
||||
#!/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
|
||||
@@ -1,317 +0,0 @@
|
||||
#----------------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,23 +0,0 @@
|
||||
#------------------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
}
|
||||
@@ -1,348 +0,0 @@
|
||||
#-------------------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
@@ -1,83 +0,0 @@
|
||||
##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
|
||||
|
||||
|
||||
|
||||
@@ -1,19 +0,0 @@
|
||||
*************************** 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 ******************************************
|
||||
@@ -1,286 +0,0 @@
|
||||
# --------------------------------------------------------------------------
|
||||
# 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
|
||||
@@ -1,47 +0,0 @@
|
||||
#---------------------------------------------------------------------------
|
||||
# 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
@@ -1,138 +0,0 @@
|
||||
##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}
|
||||
Reference in New Issue
Block a user