- Added scriptcontext driver for Dornier choppers
- Added scriptcontext driver for EL737 counter
This commit is contained in:
koennecke
422
tcl/astrium.tcl
Normal file
422
tcl/astrium.tcl
Normal file
@ -0,0 +1,422 @@
|
|||||||
|
#--------------------------------------------------------------
|
||||||
|
# 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
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
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 $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}
|
||||||
|
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 user 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 } {
|
||||||
|
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} {
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
return busy
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc astchopcheckratio {} {
|
||||||
|
set stop [hval /sics/choco/stop]
|
||||||
|
if {$stop == 1} {
|
||||||
|
return fault
|
||||||
|
}
|
||||||
|
chocosct queue /sics/choco/asyst progress read
|
||||||
|
set p1 [hval /sics/choco/chopper1/aspee]
|
||||||
|
set p2 [hval /sics/choco/chopper2/aspee]
|
||||||
|
set target [sct target]
|
||||||
|
if {$p2 < 10} {
|
||||||
|
return busy
|
||||||
|
}
|
||||||
|
if {abs($p1/$ps - $target*1.) < .3} {
|
||||||
|
set tst 1
|
||||||
|
} else {
|
||||||
|
set tst 0
|
||||||
|
}
|
||||||
|
if {$tst == 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
|
||||||
|
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
|
||||||
|
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
|
||||||
|
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
|
||||||
|
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
|
||||||
|
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 " "Chopper $count"]
|
||||||
|
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 ==========================
|
||||||
|
set amor 1
|
||||||
|
|
||||||
|
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 psts224:3014 "\r\n" 60
|
||||||
|
# makesctcontroller chocosct std localhost:8080 "\r\n" 60
|
||||||
|
chocosct debug 0
|
||||||
|
set maxspeed 5000
|
||||||
|
set minphase 0
|
||||||
|
astriumMakeChopperParameters
|
||||||
|
astMakeChopperSpeed1 chopperspeed
|
||||||
|
# astMakeChopperRatio chratio
|
||||||
|
astMakeChopperPhase2 chopper2phase
|
||||||
|
Publish chosta Spy
|
||||||
|
}
|
||||||
|
|
||||||
224
tcl/el737sec.tcl
Normal file
224
tcl/el737sec.tcl
Normal file
@ -0,0 +1,224 @@
|
|||||||
|
#-----------------------------------------------------
|
||||||
|
# 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
|
||||||
|
# values: el737readvalues - el737val
|
||||||
|
#
|
||||||
|
# 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
|
||||||
|
sct print "ERROR: $err"
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#---------------------------------------------------
|
||||||
|
proc sctroot {} {
|
||||||
|
set path [sct]
|
||||||
|
return [file dirname $path]
|
||||||
|
}
|
||||||
|
#----------------------------------------------------
|
||||||
|
proc el737sendstart {} {
|
||||||
|
set obj [sctroot]
|
||||||
|
set mode [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
|
||||||
|
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 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]
|
||||||
|
switch [string trim $reply] {
|
||||||
|
0 {
|
||||||
|
sct update idle
|
||||||
|
}
|
||||||
|
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
|
||||||
|
}
|
||||||
|
#---------------------------------------------------
|
||||||
|
# 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
|
||||||
|
}
|
||||||
|
set l [split $reply]
|
||||||
|
set root [sctroot]
|
||||||
|
if {[llength $l] > 5} {
|
||||||
|
set l2 [lrange $l 1 end]
|
||||||
|
sct update [join $l2]
|
||||||
|
set time [lindex $l 0]
|
||||||
|
hupdate ${root}/time $time
|
||||||
|
} else {
|
||||||
|
set last [expr [llength $l] - 1]
|
||||||
|
set l2 [lrange $l 0 $last]
|
||||||
|
sct update [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 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 moncount 0
|
||||||
|
$conname poll $path 60
|
||||||
|
$conname debug -1
|
||||||
|
|
||||||
|
set path /sics/${name}/control
|
||||||
|
hsetprop $path write el737control
|
||||||
|
hsetprop $path el737cmdreply el737cmdreply
|
||||||
|
$conname write $path
|
||||||
|
|
||||||
|
}
|
||||||
Reference in New Issue
Block a user