f40de7ffc6
- Added speed parameter to phytron - Added new drivers for EL755 magnets and the PI DC-406 motor controller
101 lines
3.1 KiB
Tcl
101 lines
3.1 KiB
Tcl
#------------------------------------------------------
|
|
# 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 internal 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
|
|
}
|