move folder tasmad

r3086 | jgn | 2011-03-29 15:32:07 +1100 (Tue, 29 Mar 2011) | 1 line

site_ansto/instrument/tas/config/tasmad/sicscommon/stddrive.tcl

@@ -0,0 +1,100 @@
+#------------------------------------------------------
+# This is some code for a standard drivable object in
+# the scriptcontext system. It implements an empty
+# object which throws errors when accessed. Users 
+# of such an object can override it to do 
+# something more acceptable. This object also 
+# provides for basic limit checking and status 
+# checking. It can serve as a basis for creating
+# new drivable objects, for instance environment
+# control devices. A possible user has as the 
+# first thing in a write script to set the target
+# node to the desired value.
+#
+# copyright: see file COPYRIGHT
+#
+# Mark Koennecke, November 2009
+#--------------------------------------------------------
+
+namespace eval stddrive {}
+
+proc stddrive::stdcheck {name} {
+  set val [sct target]
+  set upper [hval /sics/${name}/upperlimit]
+  set lower [hval /sics/${name}/lowerlimit]
+  if {$val < $lower || $val > $upper} {
+    error "$val is out of range $lower - $upper for $name"
+  }
+  return OK
+}
+#-------------------------------------------------------
+proc stddrive::stdstatus {name} {
+  set test [catch {sct geterror} errortxt]
+  if {$test == 0} {
+    return fault
+  }
+  set stop [hval /sics/${name}/stop]
+  if {$stop == 1} {
+    return fault
+  }
+  set target [sct target]
+  set tol [hval /sics/${name}/tolerance]
+  set is [hval /sics/${name}]
+  if {abs($target - $is) < $tol} {
+    return idle
+  } else {
+    [sct controller] queue /sics/${name} progress read
+    return busy
+  }
+}
+#-------------------------------------------------------
+proc stddrive::stop {name} {
+  hset /sics/${name}/stop 1
+  return OK
+}
+#-------------------------------------------------------
+proc stddrive::deread {} {
+  sct update -9999.99
+  return idle
+}
+#--------------------------------------------------------
+proc stddrive::dewrite {name} {
+#  hset /sics/${name}/stop 1
+  error "$name is not configured, cannot drive"
+} 
+#--------------------------------------------------------
+proc stddrive::deconfigure {name} {
+  set allowed [list upperlimit lowerlimit tolerance stop]
+  set nodelist [split [hlist /sics/${name}] \n]
+  foreach node $nodelist {
+    if {[string length $node] < 1} {
+      continue
+    }
+    if {[lsearch -exact $allowed [string trim $node]] < 0} {
+      clientput "Deleting $node"
+      hdel /sics/${name}/${node}
+    }
+  }
+  hsetprop /sics/${name} read stddrive::deread
+  hsetprop /sics/${name} write stddrive::dewrite $name
+}
+#--------------------------------------------------------
+proc stddrive::makestddrive {name sicsclass sct} {
+  makesctdriveobj $name float user $sicsclass $sct
+  hfactory /sics/${name}/tolerance plain user float
+  hset /sics/${name}/tolerance 2.0
+  hfactory /sics/${name}/upperlimit plain user float
+  hset /sics/${name}/upperlimit 300
+  hfactory /sics/${name}/lowerlimit plain user float
+  hset /sics/${name}/lowerlimit 10
+  hfactory /sics/${name}/stop plain user int
+  hset /sics/${name}/stop 0
+  
+  hsetprop /sics/${name} checklimits stddrive::stdcheck $name
+  hsetprop /sics/${name} checkstatus stddrive::stdstatus $name
+  hsetprop /sics/${name} halt stddrive::stop $name
+  deconfigure $name
+  $sct write /sics/${name}
+  $sct poll /sics/${name} 60 
+  hupdate /sics/${name} -9999.99
+}