c6b5e65a71
A "waitfor" command has been implement which waits for an object to finish after running the given command. r2687 | ffr | 2008-08-29 22:09:19 +1000 (Fri, 29 Aug 2008) | 3 lines
55 lines
1.4 KiB
Tcl
55 lines
1.4 KiB
Tcl
# TODO Maybe add ::event::onstart and ::event::onfinish commands to execute some
|
|
# code when an object starts or finishes
|
|
# eg
|
|
# onstart hmm { do something }
|
|
|
|
namespace eval event {
|
|
variable sobjBusy
|
|
variable END_EVENT
|
|
|
|
set sobjBusy 0
|
|
array set END_EVENT {Motor MOTEND HistMem COUNTEND SingleCounter COUNTEND}
|
|
namespace export waitfor
|
|
}
|
|
|
|
proc ::event::waitCB {args} {
|
|
variable sobjBusy
|
|
set sobjBusy 0
|
|
}
|
|
publish ::event::waitCB user
|
|
|
|
##
|
|
# @brief Wait for a sics object to finish what it's doing.
|
|
# waitfor hmm {histmem start}
|
|
# waitfor {samx samz} {run samx 3 samz 4}
|
|
proc ::event::waitfor {sobj args} {
|
|
variable END_EVENT
|
|
variable sobjBusy
|
|
|
|
if [ catch {
|
|
set valid_sobjType [array names END_EVENT]
|
|
set sobjType [SplitReply [sicslist $sobj type] ]
|
|
if {[lsearch $valid_sobjType $sobjType ] == -1} {
|
|
error "ERROR: You can only wait for the following types of objects $valid_sobjType"
|
|
}
|
|
set CBID [SplitReply [scriptcallback connect $sobj $END_EVENT($sobjType) ::event::waitCB ] ]
|
|
set sobjBusy 1
|
|
set oldStatus [lindex [SplitReply [status]] 0]
|
|
eval $args
|
|
while {$sobjBusy == 1} {
|
|
wait 2
|
|
}
|
|
scriptcallback remove $sobj $CBID
|
|
SetStatus $oldStatus
|
|
} message ] {
|
|
scriptcallback remove $sobj $CBID
|
|
SetStatus $oldStatus
|
|
if {$::errorCode=="NONE"} {return "Return: $message"}
|
|
return -code error "Caught $message"
|
|
}
|
|
}
|
|
|
|
namespace import ::event::waitfor
|
|
|
|
publish waitfor user
|