First draft of "action" and "waitacion" commands

r2681 | ffr | 2008-08-26 14:09:09 +1000 (Tue, 26 Aug 2008) | 2 lines

site_ansto/instrument/server_config.tcl

@@ -1,7 +1,7 @@
 # SICS common configuration
 
-# $Revision: 1.41 $
-# $Date: 2008-08-19 05:11:55 $
+# $Revision: 1.42 $
+# $Date: 2008-08-26 04:09:09 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
 # Last revision by $Author: ffr $
 
@@ -138,7 +138,7 @@ sics_release [lindex $tmpstr [expr [llength $tmpstr] - 1]]
 sics_release lock
 
 ::utility::mkVar sics_revision_num Text internal
-set tmpstr [string map {"$" ""} {$Revision: 1.41 $}]
+set tmpstr [string map {"$" ""} {$Revision: 1.42 $}]
 sics_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
 sics_revision_num lock
 
@@ -161,6 +161,45 @@ exe syspath ../batch
 
 ::utility::mkVar dataFileName Text user file_name true experiment true true
 
+##
+# @brief Internal action command procedure
+proc _action {drivecmd obj action args} {
+  if [ catch {
+    if { [SplitReply [sicslist $obj type]] != "ActionObject" } {
+      error "ERROR: $obj must be an ActionObject"
+    }
+    $obj act $action
+    $drivecmd $obj 1
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+
+##
+# @brief Non-blocking action command
+proc action {obj action args} {
+  if [ catch {
+    _action run $obj $action $args
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+publish action user
+
+##
+# @brief Blocking action command, this will wait for the action to complete.
+proc waitaction {obj action args} {
+  if [ catch {
+    _action drive $obj $action $args
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+publish waitaction user
+
 proc server_set_sobj_attributes {} { 
   if [ catch {
     foreach m [lrange [sicslist type Motor] 1 end] {