d7acb7c16c
Lakeshore 336 drivers with known IP addresses have been added to the ini files with unique IDs. All entries in the ini files now have unique IDs The wombat ini now has radio buttons to select sample stage motor configurations.
706 lines
25 KiB
Tcl
706 lines
25 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.
|
|
|
|
# Moxa RS232 configuration
|
|
# Port 3
|
|
# Baud rate : 9600
|
|
# Data bits : 8
|
|
# Stop bits : 1
|
|
# Parity : None
|
|
# Flow control : XON/XOFF
|
|
# FIFO : Enable
|
|
# Interface : RS-232
|
|
|
|
|
|
|
|
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 CID CTYPE} {
|
|
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 float internal {FETCH?} {rdData} {} {} {}\
|
|
{} Setpoint 0 1 1 float 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
|
|
hsetprop $scobj_hpath/setpoint permlink data_set ${CTYPE}${CID}SP1
|
|
|
|
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/$snsr/value permlink data_set ${CTYPE}${CID}S1
|
|
}
|
|
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} {CID 1} {CTYPE V} } {
|
|
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 $CID $CTYPE
|
|
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
|
|
|
|
if {[ catch {
|
|
if { [ info exists ::config_dict ] } {
|
|
dict for {secname secinfo} $::config_dict {
|
|
if { [dict exists $secinfo "driver"] && ([dict get $secinfo "driver"] == "k2700") } {
|
|
if { [ dict get $::secinfo enabled ] } {
|
|
set name [dict get $::secinfo name]
|
|
set IP [dict get $::secinfo ip]
|
|
set PORT [dict get $::secinfo port]
|
|
set term [dict get $::secinfo terminator]
|
|
set tol [dict get $::secinfo tol]
|
|
set cid [dict get $::secinfo id]
|
|
set ctype [dict get $::secinfo type]
|
|
|
|
add_k2700 $name $IP $PORT $term $tol $cid $ctype
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} message ]} {
|
|
puts "ERROR: $message"
|
|
}
|
|
|
|
namespace import ::scobj::k2700::*
|