b26b8fc735
- Added strlcpy and strlcat to SICS - Added a driver for the POLDI power supplies SKIPPED: psi/A1931.c psi/autowin.c psi/bruker.c psi/docho.c psi/dornier2.c psi/dspcode.c psi/ease.c psi/ecb.c psi/ecbcounter.c psi/ecbdriv.c psi/el734dc.c psi/el734driv.c psi/el734hp.c psi/el737driv.c psi/el737hpdriv.c psi/el737hpdrivsps.c psi/el737hpv2driv.c psi/el755driv.c psi/eurodriv.c psi/haakedriv.c psi/itc4driv.c psi/julcho.c psi/linadriv.c psi/lmd200.c psi/lscsupport.c psi/ltc11.c psi/make_gen psi/oicom.c psi/oxinst.c psi/pimotor.c psi/pipiezo.c psi/polterwrite.c psi/psi.c psi/sanscook.c psi/sanslirebin.c psi/sanswave.c psi/sinqhmdriv.c psi/sinqhttp.c psi/slsecho.c psi/slsmagnet.c psi/slsvme.c psi/sps.c psi/swmotor.c psi/swmotor2.c psi/tabledrive.c psi/tasscan.c psi/tdchm.c psi/velodorn.c psi/velodornier.c
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 idle
|
|
}
|
|
#-------------------------------------------------------
|
|
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
|
|
}
|