671 lines
24 KiB
Tcl
671 lines
24 KiB
Tcl
# Define procs in ::scobj::xxx namespace
|
|
# MakeSICSObj $obj SCT_<class>
|
|
# The MakeSICSObj cmd adds a /sics/$obj node. NOTE the /sics node is not browsable.
|
|
|
|
|
|
namespace eval ::scobj::k2700 {
|
|
# Environment controllers should have at least the following nodes
|
|
# /envcont/setpoint
|
|
# /envcont/sensor/value
|
|
proc debug_log {args} {
|
|
set fd [open "/tmp/k2700.log" a]
|
|
puts $fd "[clock format [clock seconds] -format "%T"] $args"
|
|
close $fd
|
|
}
|
|
|
|
# issue a command to read a register and expect a value response
|
|
proc getValue {tc_root nextState cmd} {
|
|
debug_log "getValue $cmd sct=[sct] root=$tc_root nextState=$nextState"
|
|
sct send "$cmd"
|
|
return $nextState
|
|
}
|
|
|
|
proc rdParm {tc_root} {
|
|
debug_log "rdParm tc_root=$tc_root sct=[sct]"
|
|
set data [sct result]
|
|
if {[ catch {
|
|
debug_log "rdParm $tc_root [sct] result=$data"
|
|
} catch_message ]} {
|
|
debug_log "rdParm $tc_root failure"
|
|
}
|
|
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
|
sct geterror "$data"
|
|
set nextState idle
|
|
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
|
sct geterror "Error: $data"
|
|
set nextState idle
|
|
} else {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
debug_log "rdParm Read: $data"
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
debug_log "rdParm new data for $tc_root [sct] result=$data"
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdText {tc_root} {
|
|
debug_log "rdText tc_root=$tc_root sct=[sct]"
|
|
set data [sct result]
|
|
if {[ catch {
|
|
debug_log "rdText $tc_root [sct] result=$data"
|
|
} catch_message ]} {
|
|
debug_log "rdText $tc_root failure"
|
|
}
|
|
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
|
sct geterror "$data"
|
|
set nextState idle
|
|
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
|
sct geterror "Error: $data"
|
|
set nextState idle
|
|
} else {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
debug_log "rdText Read: $data"
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
debug_log "rdText new data for $tc_root [sct] result=$data"
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdValue {tc_root} {
|
|
debug_log "rdValue tc_root=$tc_root sct=[sct]"
|
|
set data [sct result]
|
|
if {[ catch {
|
|
debug_log "rdValue $tc_root [sct] result=$data"
|
|
} catch_message ]} {
|
|
debug_log "rdValue $tc_root failure"
|
|
}
|
|
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
|
sct geterror "$data"
|
|
set nextState idle
|
|
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
|
sct geterror "Error: $data"
|
|
set nextState idle
|
|
} else {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
debug_log "rdValue new data for $tc_root [sct] result=$data"
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdData {tc_root} {
|
|
debug_log "rdData tc_root=$tc_root sct=[sct]"
|
|
set data [sct result]
|
|
if {[ catch {
|
|
debug_log "rdData $tc_root [sct] result=$data"
|
|
} catch_message ]} {
|
|
debug_log "rdData $tc_root failure"
|
|
}
|
|
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
|
sct geterror "$data"
|
|
set nextState idle
|
|
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
|
sct geterror "Error: $data"
|
|
set nextState idle
|
|
} else {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set flds [split "$data" ","]
|
|
scan [lindex $flds 0] "%f%s" value units
|
|
debug_log "rdData Read: $value $units from $data"
|
|
if {$value != [sct oldval]} {
|
|
sct oldval $value
|
|
sct update $value
|
|
sct utime readtime
|
|
sct units $units
|
|
debug_log "rdData new data for $tc_root [sct] result=$value"
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc wrParm {tc_root nextState cmd} {
|
|
debug_log "wrParm root=$tc_root sct=[sct] cmd=$cmd target=[sct target]"
|
|
set par "[sct target]"
|
|
sct send "$cmd $par"
|
|
debug_log "wrParm send: $cmd $par;*IDN?"
|
|
if {$par != [sct oldval]} {
|
|
sct oldval $par
|
|
sct update $par
|
|
sct utime readtime
|
|
debug_log "wrParm new data for $tc_root [sct] result=$par"
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
proc wrText {tc_root nextState cmd} {
|
|
debug_log "wrText root=$tc_root sct=[sct] cmd=$cmd target=[sct target]"
|
|
set par "[sct target]"
|
|
sct send "$cmd \"$par\";*IDN?"
|
|
debug_log "wrText send: $cmd \"$par\""
|
|
if {$par != [sct oldval]} {
|
|
sct oldval $par
|
|
sct update $par
|
|
sct utime readtime
|
|
debug_log "wrText new data for $tc_root [sct] result=$par"
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
# issue a command with a value in the target property of the variable
|
|
proc wrValue {tc_root nextState cmd} {
|
|
debug_log "wrValue root=$tc_root sct=[sct] cmd=$cmd target=[sct target]"
|
|
set par "[sct target]"
|
|
sct send "$cmd $par;*IDN?"
|
|
debug_log "wrValue send: $cmd $par"
|
|
if {$par != [sct oldval]} {
|
|
sct oldval $par
|
|
sct update $par
|
|
sct utime readtime
|
|
debug_log "wrValue new data for $tc_root [sct] result=$par"
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
proc wrFunc {tc_root nextState cmd} {
|
|
debug_log "wrFunc root=$tc_root sct=[sct] cmd=$cmd target=[sct target]"
|
|
set par "[sct target]"
|
|
if {[hpropexists [sct] values]} {
|
|
set target {}
|
|
set values [split [SplitReply [hgetprop [sct] values]] ","]
|
|
foreach value $values {
|
|
sct print "Testing $par against $value"
|
|
if {[string toupper "$par"] == [string toupper "$value"]} {
|
|
set target "$par"
|
|
break
|
|
}
|
|
}
|
|
if {"$target" == ""} {
|
|
return -code error "Invalid value: \"$par\""
|
|
}
|
|
}
|
|
sct send "$cmd '$par';*IDN?"
|
|
debug_log "wrFunc send: $cmd '$par'"
|
|
if {$par != [sct oldval]} {
|
|
sct oldval $par
|
|
sct update $par
|
|
sct utime readtime
|
|
debug_log "wrFunc new data for $tc_root [sct] result=$par"
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
proc wrNode {tc_root cmd level} {
|
|
set space [string repeat " " $level]
|
|
set val [hval $tc_root]
|
|
if {"$val" == ""} {
|
|
set line "$tc_root ([hinfo $tc_root])"
|
|
} else {
|
|
set line "$tc_root ([hinfo $tc_root]) = $val"
|
|
}
|
|
sct print "$space* $line"
|
|
if {"[string tolower "$cmd"]" == "-prop"} {
|
|
set props [hlistprop $tc_root]
|
|
#sct print "<<$props>>"
|
|
foreach prop $props {
|
|
#sct print "prop: $prop"
|
|
set flds [split $prop "="]
|
|
#sct print "flds: $flds"
|
|
if {[llength $flds] > 1} {
|
|
set fld0 [lindex $flds 0]
|
|
#sct print "fld0: $fld0"
|
|
if {[hpropexists $tc_root $fld0]} {
|
|
sct print "$space - [hgetprop $tc_root $fld0]"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
foreach node [hlist $tc_root] {
|
|
wrNode $tc_root/$node "$cmd" [expr {$level + 1}]
|
|
}
|
|
}
|
|
|
|
proc wrTree {tc_root nextState cmd} {
|
|
debug_log "wrTree root=$tc_root sct=[sct] cmd=$cmd target=[sct target]"
|
|
sct print "$tc_root"
|
|
wrNode $tc_root "[sct target]" 1
|
|
return idle
|
|
}
|
|
|
|
proc chkWrite {tc_root} {
|
|
set data [sct result]
|
|
debug_log "chkWrite resp=$data sct=[sct] tc_root=$tc_root"
|
|
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
|
sct geterror "$data"
|
|
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
|
sct geterror "Error: $data"
|
|
} else {
|
|
set data [sct target]
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
debug_log "chkWrite new data for $tc_root [sct] result=$data"
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc setPoint {tc_root nextState cmd} {
|
|
set catch_status [ catch {
|
|
debug_log "setPoint $tc_root $nextState $cmd sct=[sct]"
|
|
debug_log "setPoint: sct=[sct] target=[sct target] writestatus=[sct writestatus]"
|
|
sct print "setPoint: sct=[sct] target=[sct target] writestatus=[sct writestatus]"
|
|
set err_msg ""
|
|
|
|
if { $err_msg != "" } {
|
|
sct print "error:$err_msg"
|
|
debug_log "error:$err_msg"
|
|
return -code error "$err_msg"
|
|
}
|
|
|
|
set par "[sct target]"
|
|
if {[sct writestatus] == "start"} {
|
|
# Called by drive adapter
|
|
hset $tc_root/status "busy"
|
|
hsetprop $tc_root/setpoint driving 1
|
|
}
|
|
if {$par != [sct oldval]} {
|
|
sct oldval $par
|
|
sct update $par
|
|
sct utime readtime
|
|
debug_log "setPoint new data for $tc_root [sct] result=$par"
|
|
}
|
|
hset $tc_root/status "busy"
|
|
sct print "status: busy"
|
|
hset $tc_root/drive_state "START"
|
|
} catch_message ]
|
|
if {$catch_status != 0} {
|
|
hsetprop $tc_root/setpoint driving 0
|
|
return -code error $catch_message
|
|
}
|
|
sct print "setPoint: [hget $tc_root/drive_state]"
|
|
return $nextState
|
|
}
|
|
|
|
# This is the command phase of the state machine that drives the controller.
|
|
# For each state, it sends the appropriate command to get values from, or set
|
|
# values in the controller in a sequence intended to transition the controller
|
|
# between states.
|
|
proc getState {tc_root nextState cmd} {
|
|
set my_state "[SplitReply [hgetprop $tc_root/device_state my_state]]"
|
|
debug_log "getState $tc_root $nextState $cmd sct=[sct] state=$my_state"
|
|
if {[ catch {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
if {$my_state == "STATE_INIT"} {
|
|
set my_cmd "SYSTEM:PRESET;*IDN?"
|
|
hsetprop $tc_root/device_state my_state "STATE_IDN"
|
|
set nextState read
|
|
} elseif {$my_state == "STATE_IDN"} {
|
|
set my_cmd "*IDN?"
|
|
} elseif {$my_state == "STATE_CHNL_SET"} {
|
|
set my_cmd "SENS:FUNC \"VOLTS:DC\";*IDN?"
|
|
set mmf [hval $tc_root/Control/MMF]
|
|
set mbf [hval $tc_root/Control/MBF]
|
|
set mun [hval $tc_root/Control/MUN]
|
|
set my_cmd "CALC:FORM MXB;CALC:KMAT:MMF 1.0;CALC:KMAT:MBF 0.0;CALC:KMAT:MUN \"X\";CALC:STAT ON"
|
|
hsetprop $tc_root/device_state my_state "STATE_CHNL_GET"
|
|
set nextState read
|
|
} elseif {$my_state == "STATE_CHNL_GET"} {
|
|
set my_cmd "CALC:STAT?"
|
|
} elseif {$my_state == "STATE_FIELD"} {
|
|
set my_cmd "FETCH?"
|
|
} else {
|
|
hsetprop $tc_root/device_state my_state "STATE_IDN"
|
|
set my_cmd "*IDN?"
|
|
}
|
|
sct send "$my_cmd"
|
|
debug_log "getState end $tc_root state=$my_state, cmd=$my_cmd"
|
|
} catch_message ]} {
|
|
debug_log "getState error: $catch_message"
|
|
}
|
|
set old_state $my_state
|
|
set new_state "[SplitReply [hgetprop $tc_root/device_state my_state]]"
|
|
if {"$new_state" != "$old_state"} {
|
|
debug_log "getState change $old_state to $new_state"
|
|
}
|
|
debug_log "getState returns: $nextState"
|
|
return $nextState
|
|
}
|
|
|
|
# This is the response phase of the state machine that drives the controller.
|
|
# For each state, it reads the appropriate command response from the controller
|
|
# and, based on the response and internal variables performs a sequence
|
|
# intended to transition the controller between states.
|
|
|
|
##
|
|
# @brief Reads the current k2700 state and error messages.
|
|
proc rdState {tc_root} {
|
|
set my_state "[SplitReply [hgetprop $tc_root/device_state my_state]]"
|
|
debug_log "rdState $tc_root sct=[sct] state=$my_state response=\"[sct result]\""
|
|
set nextState {}
|
|
if {[ catch {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set data "[sct result]"
|
|
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
|
sct geterror "$data"
|
|
set nextState idle
|
|
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
|
sct geterror "Error: $data"
|
|
set nextState idle
|
|
} else {
|
|
debug_log "rdState $tc_root state=$my_state, response=\"[sct result]\""
|
|
if {$my_state == "STATE_INIT"} {
|
|
hsetprop $tc_root/device_state my_state "STATE_IDN"
|
|
set nextState read
|
|
} elseif {$my_state == "STATE_IDN"} {
|
|
set my_version "[sct result]"
|
|
hsetprop $tc_root/device_state my_version "$my_version"
|
|
hsetprop $tc_root/device_state my_state "STATE_CHNL_SET"
|
|
set nextState read
|
|
} elseif {$my_state == "STATE_CHNL_SET"} {
|
|
hsetprop $tc_root/device_state my_state "STATE_CHNL_GET"
|
|
set nextState read
|
|
} elseif {$my_state == "STATE_CHNL_GET"} {
|
|
hsetprop $tc_root/device_state my_state "STATE_FIELD"
|
|
hsetprop [sct] chnl [sct result]
|
|
set nextState read
|
|
} elseif {$my_state == "STATE_FIELD"} {
|
|
set my_driving [SplitReply [hgetprop $tc_root/setpoint driving]]
|
|
if { $my_driving } {
|
|
set my_sp [hval $tc_root/setpoint]
|
|
set my_pv [hval $tc_root/display/value]
|
|
set my_tol [SplitReply [hgetprop $tc_root/setpoint tolerance]]
|
|
if {$my_sp - $my_tol < $my_sp + $my_tol} {
|
|
set my_lo_tol [expr {$my_sp - $my_tol}]
|
|
} else {
|
|
set my_lo_tol [expr {$my_sp + $my_tol}]
|
|
}
|
|
if {$my_sp - $my_tol > $my_sp + $my_tol} {
|
|
set my_hi_tol [expr {$my_sp - $my_tol}]
|
|
} else {
|
|
set my_hi_tol [expr {$my_sp + $my_tol}]
|
|
}
|
|
debug_log "rdState Testing: ($my_lo_tol <= $my_pv <= $my_hi_tol) = [expr {($my_lo_tol <= $my_pv && $my_pv <= $my_hi_tol)}]"
|
|
if {($my_lo_tol <= $my_pv && $my_pv <= $my_hi_tol)} {
|
|
hsetprop $tc_root/setpoint driving 0
|
|
}
|
|
}
|
|
hsetprop $tc_root/device_state my_state "STATE_FIELD"
|
|
set nextState idle
|
|
}
|
|
}
|
|
if { $nextState == "" } {
|
|
set nextState idle
|
|
}
|
|
} catch_message ]} {
|
|
debug_log "rdState error: $catch_message"
|
|
}
|
|
set old_state $my_state
|
|
set new_state "[SplitReply [hgetprop $tc_root/device_state my_state]]"
|
|
if {"$new_state" != "$old_state"} {
|
|
debug_log "rdState change $old_state to $new_state"
|
|
}
|
|
if { "$nextState" == "" } {
|
|
set nextState "idle"
|
|
}
|
|
debug_log "rdState returns: $nextState"
|
|
return $nextState
|
|
}
|
|
|
|
proc noResponse {} {
|
|
return idle
|
|
}
|
|
proc wrtValue {wcmd args} {
|
|
}
|
|
|
|
# check that a target is within allowable limits
|
|
proc check {tc_root} {
|
|
return OK
|
|
}
|
|
|
|
# Check that the sensor is reading within tolerance of the setpoint.
|
|
# Return 1 or 0 if it is or is not, respectively.
|
|
proc checktol {tc_root currtime timecheck} {
|
|
debug_log "checktol $tc_root $currtime $timecheck"
|
|
return 1
|
|
}
|
|
|
|
##
|
|
# @brief Implement the checkstatus command for the drivable interface
|
|
#
|
|
# NOTE: The drive adapter initially sets the writestatus to "start" and will
|
|
# only call this when writestatus!="start"
|
|
proc drivestatus {tc_root} {
|
|
if {[sct driving]} {
|
|
return busy
|
|
} else {
|
|
sct print "drivestatus: idle"
|
|
hset $tc_root/status "idle"
|
|
return idle
|
|
}
|
|
}
|
|
|
|
proc halt {tc_root} {
|
|
debug_log "halt $tc_root"
|
|
sct print "halt $tc_root"
|
|
set my_driving [SplitReply [hgetprop $tc_root/setpoint driving]]
|
|
hset $tc_root/drive_state "HALT"
|
|
hsetprop $tc_root/device_state my_state "STATE_X"
|
|
if { $my_driving } {
|
|
hsetprop $tc_root/device_state my_state "STATE_A0"
|
|
return read
|
|
}
|
|
return idle
|
|
}
|
|
|
|
##
|
|
# @brief createNode() creates a node for the given nodename with the properties and virtual
|
|
# function names provided
|
|
# @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 wrValue()
|
|
# @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 ::scobj::k2700
|
|
set ns "[namespace current]"
|
|
set nodeName "$scobj_hpath/$cmdGroup/$varName"
|
|
if {1 > [string length $cmdGroup]} {
|
|
set nodeName "$scobj_hpath/$varName"
|
|
}
|
|
debug_log "Creating node $nodeName"
|
|
hfactory $nodeName plain $permission $dataType
|
|
if {$readable > 0} {
|
|
hsetprop $nodeName read ${ns}::getValue $scobj_hpath $rdFunc $rdCmd
|
|
hsetprop $nodeName $rdFunc ${ns}::$rdFunc $scobj_hpath
|
|
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 "Registering node $nodeName for poll at $poll_period seconds"
|
|
$sct_controller poll $nodeName $poll_period
|
|
}
|
|
if {$writable == 1} {
|
|
set parts [split "$wrFunc" "."]
|
|
if { [llength $parts] == 2 } {
|
|
set func_name [lindex $parts 0]
|
|
set next_state [lindex $parts 1]
|
|
hsetprop $nodeName write ${ns}::$func_name $scobj_hpath $next_state $wrCmd
|
|
hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath
|
|
} else {
|
|
hsetprop $nodeName write ${ns}::$wrFunc $scobj_hpath noResponse $wrCmd
|
|
hsetprop $nodeName noResponse ${ns}::noResponse
|
|
}
|
|
hsetprop $nodeName writestatus UNKNOWN
|
|
debug_log "Registering node $nodeName for write callback"
|
|
$sct_controller write $nodeName
|
|
}
|
|
switch -exact $dataType {
|
|
"none" { }
|
|
"int" { hsetprop $nodeName oldval -1 }
|
|
"float" { hsetprop $nodeName oldval -1.0 }
|
|
default { hsetprop $nodeName oldval UNKNOWN }
|
|
}
|
|
if {1 < [string length $allowedValues]} {
|
|
hsetprop $nodeName values $allowedValues
|
|
}
|
|
# Drive adapter interface
|
|
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
|
|
}
|
|
} message ]
|
|
if {$catch_status != 0} {
|
|
return -code error "in createNode $message"
|
|
}
|
|
return OK
|
|
}
|
|
|
|
proc mk_sct_keithley_2700 {sct_controller klass tempobj tol} {
|
|
set catch_status [ catch {
|
|
# set ns ::scobj::k2700
|
|
set ns "[namespace current]"
|
|
|
|
MakeSICSObj $tempobj SCT_OBJECT
|
|
sicslist setatt $tempobj klass $klass
|
|
sicslist setatt $tempobj long_name $tempobj
|
|
|
|
set scobj_hpath /sics/$tempobj
|
|
# Group Node R W D type perm rdCmd rdFunc wrCmd wrFunc allowed
|
|
set deviceCommand {\
|
|
Control Function 1 1 0 text user {SENS:FUNC?} {rdText} {SENS:FUNC} {wrFunc} {VOLT:DC,VOLT:AC,CURR:DC,CURR:AC,RES,FRES,CONT,FREQ,PER}\
|
|
Control Math 1 1 0 text user {CALC1:FORM?} {rdParm} {CALC1:FORM} {wrParm} {MXB}\
|
|
Control MMF 1 1 0 float user {CALC1:KMAT:MMF?} {rdValue} {CALC1:KMAT:MMF} {wrValue} {}\
|
|
Control MBF 1 1 0 float user {CALC1:KMAT:MBF?} {rdValue} {CALC1:KMAT:MBF} {wrValue} {}\
|
|
Control MUN 1 1 0 text user {CALC1:KMAT:MUN?} {rdText} {CALC1:KMAT:MUN} {wrText} {}\
|
|
Control Stat 1 1 0 text user {CALC1:STAT?} {rdParm} {CALC1:STAT} {wrParm} {ON,OFF}\
|
|
Display Value 1 0 0 text internal {FETCH?} {rdData} {} {} {}\
|
|
{} Setpoint 0 1 1 text user {} {} {} {setPoint} {}\
|
|
Display Tree 0 1 0 text user {} {} {} {wrTree} {}\
|
|
}
|
|
|
|
hfactory $scobj_hpath/Control plain spy none
|
|
hfactory $scobj_hpath/Display plain spy none
|
|
|
|
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
|
|
}
|
|
|
|
hfactory $scobj_hpath/status plain spy text
|
|
hset $scobj_hpath/status "idle"
|
|
hsetprop $scobj_hpath/status values busy,idle
|
|
|
|
hfactory $scobj_hpath/device_state plain spy text
|
|
hsetprop $scobj_hpath/device_state read ${ns}::getState $scobj_hpath rdState "X"
|
|
hsetprop $scobj_hpath/device_state rdState ${ns}::rdState $scobj_hpath
|
|
hsetprop $scobj_hpath/device_state oldval "UNKNOWN"
|
|
hsetprop $scobj_hpath/device_state my_state "STATE_FIELD"
|
|
hsetprop $scobj_hpath/device_state my_status "UNKNOWN"
|
|
hsetprop $scobj_hpath/device_state my_version "UNKNOWN"
|
|
|
|
hfactory $scobj_hpath/drive_state plain mugger text
|
|
hset $scobj_hpath/drive_state "UNKNOWN"
|
|
|
|
hfactory $scobj_hpath/remote_ctrl plain spy text
|
|
hset $scobj_hpath/remote_ctrl "UNKNOWN"
|
|
|
|
hfactory $scobj_hpath/device_lasterror plain user text
|
|
hset $scobj_hpath/device_lasterror ""
|
|
|
|
hsetprop $scobj_hpath/setpoint tolerance $tol
|
|
|
|
if {[SplitReply [environment_simulation]]=="false"} {
|
|
$sct_controller poll $scobj_hpath/device_state 1 halt read
|
|
}
|
|
|
|
hsetprop $scobj_hpath type part
|
|
foreach snsr {Display} {
|
|
foreach {rootpath hpath klass priv} "\
|
|
$scobj_hpath $snsr NXsensor spy\
|
|
$scobj_hpath $snsr/Value sensor user\
|
|
" {
|
|
hsetprop $rootpath/$hpath klass $klass
|
|
hsetprop $rootpath/$hpath privilege $priv
|
|
hsetprop $rootpath/$hpath control true
|
|
hsetprop $rootpath/$hpath data true
|
|
hsetprop $rootpath/$hpath nxsave true
|
|
}
|
|
hsetprop $scobj_hpath/$snsr type part
|
|
hsetprop $scobj_hpath/$snsr/value nxalias mm1_${snsr}_value
|
|
hsetprop $scobj_hpath/$snsr/value mutable true
|
|
hsetprop $scobj_hpath/$snsr/value sdsinfo ::nexus::scobj::sdsinfo
|
|
}
|
|
hsetprop $scobj_hpath privilege spy
|
|
::scobj::hinitprops $tempobj setpoint
|
|
if {[SplitReply [environment_simulation]]=="false"} {
|
|
ansto_makesctdrive ${tempobj}_driveable $scobj_hpath/setpoint $scobj_hpath/display/value $sct_controller
|
|
}
|
|
} catch_message ]
|
|
if {$catch_status != 0} {
|
|
return -code error $catch_message
|
|
}
|
|
}
|
|
namespace export mk_sct_keithley_2700
|
|
}
|
|
|
|
##
|
|
# @brief Create a Keithley 2700 Multimeter
|
|
#
|
|
# @param name, the name of the multimeter (eg mm1)
|
|
# @param IP, the IP address of the device, this can be a hostname, (eg ca1-kowari)
|
|
# @param port, the IP protocol port number of the device
|
|
proc add_k2700 {name IP port terminator {_tol 1.0}} {
|
|
set fd [open "/tmp/k2700.log" a]
|
|
if {[SplitReply [environment_simulation]]=="false"} {
|
|
puts $fd "makesctcontroller sct_k2700 std ${IP}:$port"
|
|
makesctcontroller sct_k2700 std ${IP}:$port $terminator
|
|
}
|
|
puts $fd "mk_sct_keithley_2700 sct_k2700 environment $name $_tol"
|
|
mk_sct_keithley_2700 sct_k2700 environment $name $_tol
|
|
close $fd
|
|
}
|
|
|
|
puts stdout "file evaluation of sct_keithley_2700.tcl"
|
|
set fd [open "/tmp/k2700.log" w]
|
|
puts $fd "file evaluation of sct_keithley_2700.tcl"
|
|
close $fd
|
|
|
|
namespace import ::scobj::k2700::*
|