Brain-dead driver for Aerotech Soloist "driver" for 12T magnet sample rotation motor
r3532 | dcl | 2012-04-10 11:16:36 +1000 (Tue, 10 Apr 2012) | 1 line
This commit is contained in:
Douglas Clowes
355
site_ansto/instrument/config/motors/sct_aerotech_soloist.tcl
Normal file
355
site_ansto/instrument/config/motors/sct_aerotech_soloist.tcl
Normal file
@@ -0,0 +1,355 @@
|
||||
# This is a template driver for a device from vendor
|
||||
#
|
||||
# Author: Douglas Clowes
|
||||
# Date: September 2011
|
||||
#
|
||||
|
||||
set vendor "aerotech"
|
||||
set device "soloist"
|
||||
|
||||
namespace eval ::scobj::[set vendor]_[set device] {
|
||||
# All of this takes place in a namespace based on the vendor and device
|
||||
# Debug prints and vendor/device save
|
||||
puts "Namespace: [namespace current]"
|
||||
puts "Vendor:[set vendor]"
|
||||
puts "Device:[set device]"
|
||||
set [namespace current]::vendor [set ::vendor]
|
||||
set [namespace current]::device [set ::device]
|
||||
set [namespace current]::ven_dev "[set ::vendor]_[set ::device]"
|
||||
puts "[namespace current]::vendor [set [namespace current]::vendor]"
|
||||
puts "[namespace current]::device [set [namespace current]::device]"
|
||||
puts "[namespace current]::ven_dev [set [namespace current]::ven_dev]"
|
||||
|
||||
proc debug_log {debug_level arg_string} {
|
||||
# write a timestamped string message to a log file for debugging
|
||||
set debug_threshold 0
|
||||
if {$debug_level >= $debug_threshold} {
|
||||
set fd [open "[set [namespace current]::log_file]" "a" 0777]
|
||||
set line "[clock format [clock seconds] -format "%T"] $arg_string"
|
||||
puts $fd "$line"
|
||||
puts "debug_log $line"
|
||||
close $fd
|
||||
}
|
||||
}
|
||||
|
||||
proc basename {node} {
|
||||
set point [string last "/" $node]
|
||||
if { $point < 0 } {
|
||||
return $node
|
||||
} else {
|
||||
incr point
|
||||
return "[string range $node $point end]"
|
||||
}
|
||||
}
|
||||
proc pathname {node} {
|
||||
set point [string last "/" $node]
|
||||
if { $point < 0 } {
|
||||
return ""
|
||||
} else {
|
||||
incr point -1
|
||||
return "[string range $node 0 $point]"
|
||||
}
|
||||
return "[join [lrange [split $node '/'] 0 end-1] '/']"
|
||||
}
|
||||
|
||||
proc ns {} {
|
||||
return "[namespace current]"
|
||||
}
|
||||
|
||||
proc setValue {tc_root nextState cmd} {
|
||||
# send a command to set a value
|
||||
debug_log 1 "setValue tc_root=$tc_root sct=[sct] $cmd [sct target]"
|
||||
if { [hpropexists [sct] geterror] } {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
set par [sct target]
|
||||
sct send "$cmd $par"
|
||||
return $nextState
|
||||
}
|
||||
|
||||
proc chkWrite {tc_root} {
|
||||
# process the response to the write
|
||||
# - not all devices will respond to writes
|
||||
set data [sct result]
|
||||
debug_log 1 "chkWrite tc_root=$tc_root sct=[sct] resp=$data"
|
||||
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
||||
# the protocol driver has reported an error
|
||||
sct geterror "$data"
|
||||
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
||||
# the device has reported an error
|
||||
sct geterror "Error: $data"
|
||||
} else {
|
||||
# the write was successful, record the data
|
||||
set data [sct target]
|
||||
if {$data != [sct oldval]} {
|
||||
sct oldval $data
|
||||
sct update $data
|
||||
sct utime readtime
|
||||
debug_log 1 "chkWrite new data for $tc_root [sct] result=$data"
|
||||
}
|
||||
}
|
||||
return idle
|
||||
}
|
||||
|
||||
proc nulWrite {tc_root} {
|
||||
set data "[sct result]"
|
||||
debug_log 1 "nulWrite tc_root=$tc_root sct=[sct] resp=$data"
|
||||
return idle
|
||||
}
|
||||
|
||||
proc getValue {tc_root nextState cmd} {
|
||||
# send a command to request a value
|
||||
debug_log 1 "getValue tc_root=$tc_root sct=[sct] $cmd"
|
||||
if { [hpropexists [sct] geterror] } {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
sct send "$cmd"
|
||||
return $nextState
|
||||
}
|
||||
|
||||
proc rdValue {tc_root} {
|
||||
# process the received response to the read request
|
||||
debug_log 1 "rdValue tc_root=$tc_root sct=[sct] result=[sct result]"
|
||||
set data [sct result]
|
||||
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
||||
# the protocol driver has reported an error
|
||||
sct geterror "$data"
|
||||
} elseif {[string equal -nocase -length 1 $data "!"]} {
|
||||
# the device has reported an error
|
||||
sct geterror "Error: $data"
|
||||
} elseif {[string equal -nocase -length 1 $data "%"]} {
|
||||
set val "[string range $data 1 end]"
|
||||
if { [string equal -nocase "[basename [sct]]" axisstatus] } {
|
||||
set txt ""
|
||||
set zzz [list 0 1 2 3 4 5 6 7 8 9 10 11 12 14 18 19 22 23 24 25 26 27 28 29 30 31]
|
||||
set xxx [list ena hom inp mov acc dec pca ccl brk cwi msc cac cen hmg afa cfd hlm llm hml mrk hia hib hic see cee est]
|
||||
for { set i 0 } {$i < [llength $zzz]} { incr i } {
|
||||
if { [string length $txt] > 0 } { set txt ":$txt" }
|
||||
if { ($val & (1 << int([lindex $zzz $i]))) == 0 } {
|
||||
set txt "[string tolower [lindex $xxx $i]]$txt"
|
||||
} else {
|
||||
set txt "[string toupper [lindex $xxx $i]]$txt"
|
||||
}
|
||||
}
|
||||
set val [format "0x%08X" $val]
|
||||
}
|
||||
if {$val != [sct oldval]} {
|
||||
debug_log 1 "[sct] new:$val, old:[sct oldval]"
|
||||
sct oldval $val
|
||||
sct update $val
|
||||
sct utime readtime
|
||||
debug_log 1 "[pathname [sct]] new:$txt, old:[hval [pathname [sct]]]"
|
||||
hset "[pathname [sct]]/axistext" "$txt"
|
||||
}
|
||||
} else {
|
||||
set fields [split "$data"]
|
||||
set rate [lindex $fields end]
|
||||
debug_log 1 "Rate new:$rate, old:[sct oldval]"
|
||||
if {$rate != [sct oldval]} {
|
||||
sct oldval $rate
|
||||
sct update $rate
|
||||
sct utime readtime
|
||||
}
|
||||
}
|
||||
return idle
|
||||
}
|
||||
|
||||
##
|
||||
# @brief createNode() creates a node for the given nodename with the properties given
|
||||
#
|
||||
# @param scobj_hpath string variable holding the path to the object's base node in sics (/sample/tc1)
|
||||
# @param sct_controller name of the scriptcontext object (typically sct_xxx_yyy)
|
||||
# @param cmdGroup subdirectory (below /sample/tc*/) in which the node is to be created
|
||||
# @param varName name of the actual node typically representing one device command
|
||||
# @param readable set to 1 if the node represents a query command, 0 if it is not
|
||||
# @param writable set to 1 if the node represents a request for a change in settings sent to the device
|
||||
# @param drivable if set to 1 it prepares the node to provide a drivable interface
|
||||
# @param dataType data type of the node, must be one of none, int, float, text
|
||||
# @param permission defines what user group may read/write to this node (is one of spy, user, manager)
|
||||
# @param rdCmd actual device query command to be sent to the device
|
||||
# @param rdFunc nextState Function to be called after the getValue function, typically rdValue()
|
||||
# @param wrCmd actual device write command to be sent to the device
|
||||
# @param wrFunc Function to be called to send the wrCmd to the device, typically setValue()
|
||||
# @param allowedValues allowed values for the node data - does not permit other
|
||||
# @param klass Nexus class name (?)
|
||||
# @return OK
|
||||
proc createNode {scobj_hpath sct_controller\
|
||||
cmdGroup varName\
|
||||
readable writable drivable\
|
||||
dataType permission\
|
||||
rdCmd rdFunc\
|
||||
wrCmd wrFunc\
|
||||
allowedValues klass} {
|
||||
|
||||
set catch_status [ catch {
|
||||
set ns "[namespace current]"
|
||||
set nodeName "$scobj_hpath/$cmdGroup/$varName"
|
||||
if {1 > [string length $cmdGroup]} {
|
||||
set nodeName "$scobj_hpath/$varName"
|
||||
}
|
||||
debug_log 1 "Creating node $nodeName"
|
||||
hfactory $nodeName plain $permission $dataType
|
||||
if {$readable > 0} {
|
||||
# the node is readable so set it up to be polled using the rdFunc
|
||||
# rdFunc is getValueFunc.rdValueFunc with both explicit functions
|
||||
# or rdValueFunc where "getValue" is the implied getValueFunc
|
||||
set parts [split "$rdFunc" "."]
|
||||
if { [llength $parts] == 2 } {
|
||||
set func_name [lindex $parts 0]
|
||||
set next_state [lindex $parts 1]
|
||||
} else {
|
||||
set func_name "getValue"
|
||||
set next_state [lindex $parts 0]
|
||||
}
|
||||
hsetprop $nodeName read ${ns}::$func_name $scobj_hpath $next_state $rdCmd
|
||||
hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath
|
||||
# set the poll rate as a period in seconds
|
||||
# TODO allow directly settable value in seconds
|
||||
set poll_period 30
|
||||
if { $readable >= 0 && $readable <= 9 } {
|
||||
set poll_period [lindex [list 0 1 2 3 4 5 10 15 20 30] $readable]
|
||||
}
|
||||
debug_log 1 "Registering node $nodeName for poll at $poll_period seconds"
|
||||
$sct_controller poll $nodeName $poll_period
|
||||
}
|
||||
if {$writable == 1} {
|
||||
# the node is writable so set it up to invoke a callback when written
|
||||
# rdFunc is putValueFunc.chkWriteFunc with both explicit functions
|
||||
# or putValueFunc where "noResponse" is the implied chkWriteFunc
|
||||
set parts [split "$wrFunc" "."]
|
||||
if { [llength $parts] == 2 } {
|
||||
set func_name [lindex $parts 0]
|
||||
set next_state [lindex $parts 1]
|
||||
} else {
|
||||
set func_name [lindex $parts 0]
|
||||
set next_state "noResponse"
|
||||
}
|
||||
hsetprop $nodeName write ${ns}::$func_name $scobj_hpath $next_state $wrCmd
|
||||
hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath
|
||||
hsetprop $nodeName writestatus UNKNOWN
|
||||
debug_log 1 "Registering node $nodeName for write callback"
|
||||
$sct_controller write $nodeName
|
||||
}
|
||||
# Initialise the previous value to test against
|
||||
switch -exact $dataType {
|
||||
"none" { }
|
||||
"int" { hsetprop $nodeName oldval -1 }
|
||||
"float" { hsetprop $nodeName oldval -1.0 }
|
||||
default { hsetprop $nodeName oldval UNKNOWN }
|
||||
}
|
||||
# Set the allowed values property
|
||||
if {1 < [string length $allowedValues]} {
|
||||
hsetprop $nodeName values $allowedValues
|
||||
}
|
||||
# Drive adapter interface
|
||||
# TODO make it a separate function and pass in all this stuff
|
||||
if {$drivable == 1} {
|
||||
hsetprop $nodeName check ${ns}::check $scobj_hpath
|
||||
hsetprop $nodeName driving 0
|
||||
hsetprop $nodeName checklimits ${ns}::check $scobj_hpath
|
||||
hsetprop $nodeName checkstatus ${ns}::drivestatus $scobj_hpath
|
||||
hsetprop $nodeName halt ${ns}::halt $scobj_hpath
|
||||
} else {
|
||||
hsetprop $nodeName driving 0
|
||||
}
|
||||
} catch_message ]
|
||||
if {$catch_status != 0} {
|
||||
debug_log 5 "error in [ns]::createNode $catch_message"
|
||||
return -code error "in [ns]::createNode $catch_message"
|
||||
}
|
||||
return OK
|
||||
}
|
||||
|
||||
proc mk_sct_driver {sct_controller klass name tol} {
|
||||
set [ns]::log_file "/tmp/[set [ns]::ven_dev]_${name}.log"
|
||||
debug_log 1 "mk_sct_driver $sct_controller $klass $name $tol"
|
||||
set catch_status [ catch {
|
||||
|
||||
MakeSICSObj $name SCT_OBJECT
|
||||
sicslist setatt $name klass $klass
|
||||
sicslist setatt $name long_name $name
|
||||
|
||||
set scobj_hpath /sics/$name
|
||||
|
||||
set deviceCommand {\
|
||||
{} axisstatus 1 0 0 text user {AXISSTATUS()} {rdValue} {} {} {}\
|
||||
{} axistext 0 0 0 text user {} {} {} {} {}\
|
||||
{} position 1 0 0 float user {PFBK()} {rdValue} {} {} {}\
|
||||
{} velocity 1 0 0 float user {VFBK()} {rdValue} {} {} {}\
|
||||
}
|
||||
|
||||
foreach {cmdGroup varName\
|
||||
readable writable drivable\
|
||||
dataType permission\
|
||||
rdCmd rdFunc\
|
||||
wrCmd wrFunc\
|
||||
allowedValues} $deviceCommand {
|
||||
createNode $scobj_hpath $sct_controller\
|
||||
$cmdGroup $varName\
|
||||
$readable $writable $drivable\
|
||||
$dataType $permission\
|
||||
$rdCmd $rdFunc\
|
||||
$wrCmd $wrFunc\
|
||||
$allowedValues $klass
|
||||
}
|
||||
|
||||
} catch_message ]
|
||||
if {$catch_status != 0} {
|
||||
debug_log 5 "error in [ns]::mk_sct_driver $catch_message"
|
||||
return -code error "in [ns]::mk_sct_driver $catch_message"
|
||||
}
|
||||
}
|
||||
|
||||
proc add_[set vendor]_[set device] {name IP port {_tol 5.0}} {
|
||||
###puts "Namespace: [ns]"
|
||||
###puts "::vendor $::vendor"
|
||||
###puts "::device $::device"
|
||||
###puts "[ns]::vendor [set [ns]::vendor]"
|
||||
###puts "[ns]::device [set [ns]::device]"
|
||||
###puts "[ns]::ven_dev [set [ns]::ven_dev]"
|
||||
set [ns]::log_file "/tmp/[set [ns]::ven_dev]_[set name].log"
|
||||
debug_log 1 "add_[set [ns]::vendor]_[set [ns]::device] ${name} ${IP} ${port} ${_tol}"
|
||||
if {[SplitReply [environment_simulation]]=="false"} {
|
||||
debug_log 1 "makesctcontroller sct_${name} std ${IP}:${port}"
|
||||
makesctcontroller sct_${name} std ${IP}:${port} "\n" 30.0
|
||||
}
|
||||
debug_log 1 "mk_sct_driver sct_${name} environment ${name} ${_tol}"
|
||||
mk_sct_driver sct_${name} environment ${name} ${_tol}
|
||||
}
|
||||
|
||||
|
||||
namespace export add_[set vendor]_[set device]
|
||||
}
|
||||
|
||||
namespace import ::scobj::[set vendor]_[set device]::*
|
||||
|
||||
#
|
||||
# below this point is debugging only
|
||||
#
|
||||
if { "[lindex [split [info nameofexecutable] "/"] end]" == "tclsh"} {
|
||||
set catch_status [ catch {
|
||||
puts "TCLSH"
|
||||
proc environment_simulation {} { return "" }
|
||||
proc SplitReply {str} { return "" }
|
||||
proc makesctcontroller {args} { }
|
||||
proc MakeSICSObj {args} { }
|
||||
proc sicslist {args} { }
|
||||
proc hfactory {args} { }
|
||||
proc hsetprop {args} { }
|
||||
proc sct {args} {
|
||||
puts $args
|
||||
}
|
||||
|
||||
proc sct_bm1 {args} { }
|
||||
add_ansto_bm "bm1" 127.0.0.1 4001 2.0
|
||||
|
||||
proc sct_bm2 {args} { }
|
||||
add_ansto_bm "bm2" 127.0.0.1 4002 2.0
|
||||
|
||||
} catch_message ]
|
||||
if {$catch_status != 0} {
|
||||
puts "error in main $catch_message"
|
||||
return -code error "in main $catch_message"
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user