630 lines
21 KiB
Tcl
Executable File
630 lines
21 KiB
Tcl
Executable File
# 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::syr {
|
|
# Environment controllers should have at least the following nodes
|
|
# /envcont/setpoint
|
|
# /envcont/sensor/value
|
|
proc debug_log {args} {
|
|
set fd [open "../log/syr.log" a]
|
|
puts $fd "[clock format [clock seconds] -format "%T"] $args"
|
|
close $fd
|
|
}
|
|
|
|
proc getDev {tc_root} {
|
|
set dev 0
|
|
foreach item [split "[sct]" "/"] {
|
|
if {[string equal -nocase -length 4 $item "Pump"]} {
|
|
set dev [expr {int([string range $item 4 end])}]
|
|
debug_log "Node [sct] gives $item for dev = $dev"
|
|
}
|
|
}
|
|
debug_log "getDev sct=[sct] root=$tc_root dev=$dev"
|
|
return $dev
|
|
}
|
|
|
|
# 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"
|
|
set dev [getDev $tc_root]
|
|
sct send "$dev$cmd"
|
|
return $nextState
|
|
}
|
|
|
|
# issue a command with a value in the target property of the variable
|
|
proc setValue {tc_root nextState cmd} {
|
|
debug_log "setValue cmd=$cmd sct=[sct] $tc_root"
|
|
set par "[sct target]"
|
|
sct send "$cmd $par"
|
|
debug_log "setValue $cmd $par"
|
|
return $nextState
|
|
}
|
|
|
|
proc wrCld {tc_root nextState cmd} {
|
|
debug_log "wrCld cmd=$cmd [sct target] sct=[sct] $tc_root"
|
|
set data [string toupper [sct target]]
|
|
if {"$data" != "INF" && "$data" != "WDR"} {
|
|
set err_msg "Invalid Cld \"$data\" is not \"INF\" or \"WDR\""
|
|
debug_log "error:$err_msg"
|
|
return -code error "$err_msg"
|
|
}
|
|
set dev [getDev $tc_root]
|
|
set line "${dev}CLD${data}"
|
|
debug_log "wrCld $line"
|
|
sct send "$line"
|
|
return $nextState
|
|
}
|
|
|
|
proc wrOut {tc_root nextState cmd} {
|
|
set line "[getDev $tc_root]OUT0[sct target]"
|
|
debug_log "send: $line"
|
|
sct send "$line"
|
|
return $nextState
|
|
}
|
|
|
|
proc wrRat {tc_root nextState cmd} {
|
|
set line "[getDev $tc_root]RAT[sct target]"
|
|
debug_log "send: $line"
|
|
sct send "$line"
|
|
return $nextState
|
|
}
|
|
|
|
proc wrVol {tc_root nextState cmd} {
|
|
set line "[getDev $tc_root]VOL[sct target]"
|
|
debug_log "send: $line"
|
|
sct send "$line"
|
|
return $nextState
|
|
}
|
|
|
|
proc wrBuz {tc_root nextState cmd} {
|
|
set line "[getDev $tc_root]BUZ[sct target]"
|
|
debug_log "send: $line"
|
|
sct send "$line"
|
|
return $nextState
|
|
}
|
|
|
|
proc wrDir {tc_root nextState cmd} {
|
|
debug_log "wrDir cmd=$cmd [sct target] sct=[sct] $tc_root"
|
|
set data [string toupper [sct target]]
|
|
if {"$data" != "INF" && "$data" != "WDR"} {
|
|
set err_msg "Invalid Dir \"$data\" is not \"INF\" or \"WDR\""
|
|
debug_log "error:$err_msg"
|
|
return -code error "$err_msg"
|
|
}
|
|
set dev [getDev $tc_root]
|
|
set line "${dev}DIR${data}"
|
|
debug_log "wrDir $line"
|
|
sct send "$line"
|
|
return $nextState
|
|
}
|
|
|
|
proc setCmnd {tc_root nextState cmd} {
|
|
debug_log "setCmnd cmd=$cmd [sct target] sct=[sct] $tc_root"
|
|
set dev [SplitReply [hgetprop $tc_root device]]
|
|
if {[string range [sct target] 0 1] == "1"} {
|
|
set data [sct target]
|
|
} else {
|
|
set data "$dev[string toupper [sct target]]"
|
|
}
|
|
sct send "$data"
|
|
debug_log "setCmnd $data"
|
|
return $nextState
|
|
}
|
|
|
|
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 NAK: $data"
|
|
} else {
|
|
if {[string equal -nocase -length 1 $data "\002"]} {
|
|
set data [string range $data 1 end]
|
|
}
|
|
set cmnd [string toupper [sct target]]
|
|
debug_log "Command: \"$cmnd\" Response: \"$data\""
|
|
set data "$cmnd -> $data"
|
|
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 wrRun {tc_root nextState cmd} {
|
|
set catch_status [ catch {
|
|
debug_log "wrRun: $tc_root $nextState $cmd sct=[sct]"
|
|
debug_log "wrRun: sct=[sct] target=[sct target] writestatus=[sct writestatus]"
|
|
set err_msg ""
|
|
set data [expr {[sct target]}]
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
debug_log "wrRun new data for $tc_root [sct] data=$data"
|
|
}
|
|
debug_log "wrRun send: *RUN"
|
|
sct send "*RUN"
|
|
debug_log "status: busy"
|
|
hsetprop $tc_root/Pump0/Run driving 1
|
|
} catch_message ]
|
|
if {$catch_status != 0} {
|
|
return -code error $catch_message
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
proc ValidateResponse {tc_root data} {
|
|
debug_log "ValidateResponse tc_root=$tc_root sct=[sct] node=[lindex [split [sct] "/"] end]"
|
|
if {[ catch {
|
|
debug_log "ValidateResponse $tc_root [sct] result=$data"
|
|
} catch_message ]} {
|
|
debug_log "ValidateResponse $tc_root failure"
|
|
}
|
|
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
|
set rslt [list 0 "$data" "XX" "XX"]
|
|
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
|
set rslt [list 0 "$data" "XX" "XX"]
|
|
} elseif {![string equal -nocase -length 1 $data "\002"]} {
|
|
set rslt [list 0 "$data" "XX" "XX"]
|
|
} else {
|
|
set data [string range $data 1 end]
|
|
sct result $data
|
|
set addr [string range $data 0 1]
|
|
if {[string equal -length 1 $addr "0"]} {
|
|
set addr [string range $addr 1 end]
|
|
}
|
|
set stat [string range $data 2 2]
|
|
set data [string range $data 3 end]
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set rslt [list 1 "$data" "$addr" "$stat"]
|
|
}
|
|
debug_log "ValidateResponse: $rslt"
|
|
return $rslt
|
|
}
|
|
|
|
proc rdRat {tc_root} {
|
|
set response [ValidateResponse $tc_root [sct result]]
|
|
set stat [lindex $response 0]
|
|
set data [lindex $response 1]
|
|
if {!$stat} {
|
|
sct geterror "$data"
|
|
debug_log "rdRat error: $data"
|
|
return -code error "$data"
|
|
}
|
|
# TODO - process data XX.XXMM
|
|
if {$data != [sct oldval]} {
|
|
debug_log "rdRat new data for $tc_root [sct] was=[sct oldval] now=$data"
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdVol {tc_root} {
|
|
set response [ValidateResponse $tc_root [sct result]]
|
|
set stat [lindex $response 0]
|
|
set data [lindex $response 1]
|
|
if {!$stat} {
|
|
sct geterror "$data"
|
|
debug_log "rdVol error: $data"
|
|
return -code error "$data"
|
|
}
|
|
# TODO - process data XX.XXMM
|
|
if {$data != [sct oldval]} {
|
|
debug_log "rdVol new data for $tc_root [sct] was=[sct oldval] now=$data"
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdDir {tc_root} {
|
|
set response [ValidateResponse $tc_root [sct result]]
|
|
set stat [lindex $response 0]
|
|
set data [lindex $response 1]
|
|
if {!$stat} {
|
|
sct geterror "$data"
|
|
debug_log "rdDir error: $data"
|
|
return -code error "$data"
|
|
}
|
|
if {$data != [sct oldval]} {
|
|
debug_log "rdDir new data for $tc_root [sct] was=[sct oldval] now=$data"
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdBuz {tc_root} {
|
|
set response [ValidateResponse $tc_root [sct result]]
|
|
set stat [lindex $response 0]
|
|
set data [lindex $response 1]
|
|
if {!$stat} {
|
|
sct geterror "$data"
|
|
debug_log "rdBuz error: $data"
|
|
return -code error "$data"
|
|
}
|
|
if {$data != [sct oldval]} {
|
|
debug_log "rdBuz new data for $tc_root [sct] was=[sct oldval] now=$data"
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdDis {tc_root} {
|
|
set response [ValidateResponse $tc_root [sct result]]
|
|
set stat [lindex $response 0]
|
|
set data [lindex $response 1]
|
|
if {!$stat} {
|
|
sct geterror "$data"
|
|
debug_log "rdDis error: $data"
|
|
return -code error "$data"
|
|
}
|
|
# TODO - process data XX.XXMM
|
|
if {$data != [sct oldval]} {
|
|
debug_log "rdDis new data for $tc_root [sct] was=[sct oldval] now=$data"
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdInp {tc_root} {
|
|
set response [ValidateResponse $tc_root [sct result]]
|
|
set stat [lindex $response 0]
|
|
set data [lindex $response 1]
|
|
if {!$stat} {
|
|
sct geterror "$data"
|
|
debug_log "rdInp error: $data"
|
|
return -code error "$data"
|
|
}
|
|
if {$data != [sct oldval]} {
|
|
debug_log "rdInp new data for $tc_root [sct] was=[sct oldval] now=$data"
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdVer {tc_root} {
|
|
set response [ValidateResponse $tc_root [sct result]]
|
|
set stat [lindex $response 0]
|
|
set data [lindex $response 1]
|
|
if {!$stat} {
|
|
sct geterror "$data"
|
|
debug_log "rdVer error: $data"
|
|
return -code error "$data"
|
|
}
|
|
if {$data != [sct oldval]} {
|
|
debug_log "rdVer new data for $tc_root [sct] was=[sct oldval] now=$data"
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
return idle
|
|
}
|
|
|
|
# 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} {
|
|
debug_log "getState $tc_root $nextState sct=[sct]"
|
|
if {[ catch {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set my_state [sct my_state]
|
|
set my_substate [sct my_substate]
|
|
if {$my_state == "STATE_INIT"} {
|
|
if {$my_substate == 0} {
|
|
set my_cmd "VER"
|
|
}
|
|
} elseif {$my_state == "STATE_IDLE"} {
|
|
set my_cmd "VER"
|
|
} elseif {$my_state == "STATE_BUSY"} {
|
|
set my_cmd "VER"
|
|
} elseif {$my_state == "STATE_ERROR"} {
|
|
set my_cmd "VER"
|
|
}
|
|
debug_log "getState sends: \"$my_cmd\""
|
|
sct send "$my_cmd"
|
|
} catch_message ]} {
|
|
debug_log "getState error: $catch_message"
|
|
}
|
|
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 SYR state and error messages.
|
|
proc rdState {tc_root} {
|
|
debug_log "rdState $tc_root sct=[sct] response=\"[sct result]\""
|
|
set response [ValidateResponse $tc_root [sct result]]
|
|
set succ [lindex $response 0]
|
|
set data [lindex $response 1]
|
|
set addr [lindex $response 2]
|
|
set stat [lindex $response 3]
|
|
if {!$succ} {
|
|
sct geterror "$data"
|
|
debug_log "rdState error: $data"
|
|
return -code error "$data"
|
|
}
|
|
set nextState {}
|
|
if {[ catch {
|
|
set my_state [sct my_state]
|
|
set my_substate [sct my_substate]
|
|
if { $my_state == "STATE_INIT" } {
|
|
if { $my_substate == 0 } {
|
|
sct my_state "STATE_IDLE"
|
|
sct my_substate 0
|
|
}
|
|
} elseif { $my_state == "STATE_IDLE" } {
|
|
if { "[SplitReply [hgetprop $tc_root/Pump0/Run driving]]" } {
|
|
sct my_state "STATE_BUSY"
|
|
sct my_substate 0
|
|
}
|
|
} elseif { $my_state == "STATE_BUSY" } {
|
|
if {[string equal -nocase -length 1 $stat "S"]} {
|
|
hsetprop $tc_root/Pump0/Run driving 0
|
|
sct my_state "STATE_IDLE"
|
|
sct my_substate 0
|
|
}
|
|
} elseif { $my_state == "STATE_ERROR" } {
|
|
sct my_state "STATE_IDLE"
|
|
sct my_substate 0
|
|
}
|
|
} catch_message ]} {
|
|
debug_log "rdState error: $catch_message"
|
|
}
|
|
if { "$nextState" == "" } {
|
|
set nextState "idle"
|
|
}
|
|
if {![string equal [sct oldval] [sct my_state]]} {
|
|
sct oldval [sct my_state]
|
|
sct update [sct my_state]
|
|
sct utime readtime
|
|
}
|
|
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} {
|
|
# set setpoint [sct target]
|
|
# set lolimit 1
|
|
# set hilimit 6
|
|
# if {$setpoint < $lolimit || $setpoint > $hilimit} {
|
|
# error "setpoint violates limits"
|
|
# }
|
|
return OK
|
|
}
|
|
|
|
##
|
|
# @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 {
|
|
return idle
|
|
}
|
|
}
|
|
|
|
proc halt {tc_root} {
|
|
debug_log "halt $tc_root"
|
|
sct print "halt $tc_root"
|
|
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 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 nexus gumtree\
|
|
drivable dataType permission rdCmd rdFunc wrCmd\
|
|
wrFunc allowedValues klass} {
|
|
debug_log "createNode cmdGroup = $cmdGroup"
|
|
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 "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 && "$wrFunc" != ""} {
|
|
set pos [string first "." "$wrFunc"]
|
|
if { $pos > 0 } {
|
|
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
|
|
}
|
|
if {$nexus == 1} {
|
|
hsetprop $nodeName type part
|
|
hsetprop $nodeName klass $klass
|
|
hsetprop $nodeName privilege $permission
|
|
hsetprop $nodeName control true
|
|
hsetprop $nodeName data true
|
|
hsetprop $nodeName nxsave true
|
|
hsetprop $nodeName data true
|
|
}
|
|
if {$gumtree == 1} {
|
|
}
|
|
} catch_message ]
|
|
if {$catch_status != 0} {
|
|
debug_log "error: $catch_message"
|
|
return -code error "in createNode $catch_message"
|
|
}
|
|
return OK
|
|
}
|
|
|
|
proc mk_sct_syr {sct_controller klass tempobj} {
|
|
set catch_status [ catch {
|
|
set ns "[namespace current]"
|
|
|
|
MakeSICSObj $tempobj SCT_OBJECT
|
|
sicslist setatt $tempobj klass $klass
|
|
sicslist setatt $tempobj long_name $tempobj
|
|
|
|
set scobj_hpath /sics/$tempobj
|
|
|
|
set deviceCommand {\
|
|
Pump Run 0 1 1 1 1 text user {} {} {RUN} {wrRun} {}\
|
|
Pump Cld 0 1 1 1 0 text user {} {} {CLD} {wrCld} {}\
|
|
Pump Out 0 1 1 1 0 text user {} {} {OUT} {wrOut} {}\
|
|
Pump Rat 1 1 1 1 0 text user {RAT} {rdRat} {RAT} {wrRat} {}\
|
|
Pump Vol 1 1 1 1 0 text user {VOL} {rdVol} {VOL} {wrVol} {}\
|
|
Pump Dir 1 1 1 1 0 text user {DIR} {rdDir} {DIR} {wrDir} {}\
|
|
Pump Buz 1 1 1 1 0 text user {BUZ} {rdBuz} {BUZ} {wrBuz} {}\
|
|
Pump Dis 1 0 1 1 0 text internal {DIS} {rdDis} {} {} {}\
|
|
Pump In2 1 0 1 1 0 text internal {IN2} {rdInp} {} {} {}\
|
|
Pump In3 1 0 1 1 0 text internal {IN3} {rdInp} {} {} {}\
|
|
Pump In4 1 0 1 1 0 text internal {IN4} {rdInp} {} {} {}\
|
|
Pump In6 1 0 1 1 0 text internal {IN6} {rdInp} {} {} {}\
|
|
Pump Ver 1 0 1 1 0 text internal {VER} {rdVer} {} {} {}\
|
|
}
|
|
|
|
set num_pumps 2
|
|
for {set i 0} { $i < $num_pumps } { incr i } {
|
|
set cmdGroup "Pump[set i]"
|
|
hfactory $scobj_hpath/[set cmdGroup] plain spy none
|
|
foreach {cmdGroup varName readable writable nexus gumtree drivable dataType permission rdCmd rdFunc wrCmd wrFunc allowedValues} $deviceCommand {
|
|
createNode $scobj_hpath $sct_controller ${cmdGroup}$i $varName $readable $writable $nexus $gumtree $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
|
|
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_INIT"
|
|
hsetprop $scobj_hpath/device_state my_substate "0"
|
|
|
|
# if {[SplitReply [environment_simulation]]=="false"} {
|
|
# }
|
|
debug_log "Registering node $scobj_hpath/device_state for poll at 1 seconds"
|
|
$sct_controller poll $scobj_hpath/device_state 1 halt read
|
|
ansto_makesctdrive ${tempobj}_driveable $scobj_hpath/pump0/run $scobj_hpath/pump0/dis $sct_controller
|
|
|
|
|
|
} catch_message ]
|
|
if {$catch_status != 0} {
|
|
debug_log "error: $catch_message"
|
|
return -code error $catch_message
|
|
}
|
|
}
|
|
namespace export mk_sct_syr
|
|
}
|
|
|
|
##
|
|
# @brief Create an SYR Controller
|
|
#
|
|
# @param name, the name of the SYR
|
|
# @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_syr {name IP port} {
|
|
set fd [open "../log/syr.log" a]
|
|
if {[SplitReply [environment_simulation]]=="false"} {
|
|
makesctcontroller sct_syr syringe ${IP}:$port "\r"
|
|
}
|
|
puts $fd "mk_sct_syr sct_syr environment $name"
|
|
mk_sct_syr sct_syr environment $name
|
|
close $fd
|
|
}
|
|
|
|
clientput "file evaluation of sct_syr.tcl"
|
|
set fd [open "../log/syr.log" w]
|
|
puts $fd "file evaluation of sct_syr.tcl"
|
|
close $fd
|
|
|
|
namespace import ::scobj::syr::*
|
|
|
|
#add_syr syr 192.168.56.101 6000
|