1091 lines
40 KiB
Tcl
1091 lines
40 KiB
Tcl
# vim: ts=8 sts=2 sw=2 expandtab si sta
|
|
# Script Context Driver for the Perten (Newport Scientific) Rapid Visco Analyzer Starch Master 2
|
|
# or Techmaster - hence the terms Newport, RVA and SM2 or TM in documentation.
|
|
#
|
|
# 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::newport_rva {
|
|
# Temperature controllers must have at least the following nodes
|
|
# /tempcont/setpoint
|
|
# /tempcont/sensor/value
|
|
proc debug_log {args} {
|
|
set fd [open "../log/newport_rva.log" a]
|
|
puts $fd "[clock format [clock seconds] -format "%T"] $args"
|
|
close $fd
|
|
}
|
|
|
|
# issue a command with a value in the target property of the variable
|
|
proc setValue {tc_root nextState cmd} {
|
|
set par [sct target]
|
|
sct send "$cmd $par"
|
|
debug_log "setValue $cmd $par"
|
|
return $nextState
|
|
}
|
|
|
|
# issue a command to read a register and expect a value response
|
|
proc getValue {tc_root nextState cmd} {
|
|
debug_log "getValue $cmd => $nextState"
|
|
sct send "$cmd"
|
|
return $nextState
|
|
}
|
|
|
|
# process the response to getValue and save the value
|
|
proc rdValue {tc_root} {
|
|
debug_log "rdValue [sct] [sct result]"
|
|
set data [sct result]
|
|
switch -glob -- $data {
|
|
"ASCERR:*" {
|
|
sct geterror $data
|
|
}
|
|
default {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc setTemp {tc_root nextState cmd} {
|
|
debug_log "setTemp $tc_root $nextState $cmd [sct]=[sct target] [hget [sct]]"
|
|
if {[sct writestatus] == "start"} {
|
|
# Called by drive adapter
|
|
hset $tc_root/status "busy"
|
|
hsetprop $tc_root/setpoint driving 1
|
|
}
|
|
# ANSTO special temperature
|
|
set temp [expr {20.0 * [sct target]}]
|
|
set cmd "STT[format %04X [expr {int($temp)}]]"
|
|
debug_log "sct send $cmd"
|
|
sct send "$cmd"
|
|
return $nextState
|
|
}
|
|
|
|
proc rdTemp {tc_root} {
|
|
debug_log "rdTemp [sct] [sct result]"
|
|
set data [sct result]
|
|
switch -glob -- $data {
|
|
"ASCERR:*" {
|
|
sct geterror $data
|
|
}
|
|
default {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set flist [split $data " "]
|
|
if {[llength $flist] != 2} {
|
|
sct geterror "Field error: expected two fields, received $data"
|
|
return idle
|
|
}
|
|
set data [lindex $flist 0]
|
|
set stts [lindex $flist 1]
|
|
if {[string length $stts] != 4} {
|
|
sct geterror "Length error: expected RSxx but received $data"
|
|
} elseif {[string range $stts 0 1] != "RS"} {
|
|
sct geterror "Unexpected status: expected RSxx but received $stts"
|
|
} elseif {![string is xdigit [string range $stts 2 3]]} {
|
|
sct geterror "Hexadecimal error: expected RSxx but received $data"
|
|
} elseif {[string length $data] != 7} {
|
|
sct geterror "Length error: expected SRTxxxx but received $data"
|
|
} elseif {[string range $data 0 2] != "SRT"} {
|
|
sct geterror "Unexpected response: expected SRTxxxx but received $data"
|
|
} elseif {![string is xdigit [string range $data 3 6]]} {
|
|
sct geterror "Hexadecimal error: expected SRTxxxx but received $data"
|
|
} else {
|
|
debug_log "scan [string range $data 3 6] %4x data"
|
|
set rslt [scan [string range $data 3 6] %4x data]
|
|
# ANSTO special temp
|
|
set data [format "%.1f" [expr {$data / 20.0}]]
|
|
debug_log "scan result rslt=$rslt, data=$data, oldval=[sct oldval]"
|
|
if {"$data" ne "[sct oldval]"} {
|
|
debug_log "$data != [sct oldval] => [expr {"$data" != "[sct oldval]"}]"
|
|
debug_log "$data == [sct oldval] => [expr {"$data" == "[sct oldval]"}]"
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
debug_log "update result data=$data, oldval=[sct oldval]"
|
|
}
|
|
# TODO handle end of drive command
|
|
if {abs([hval $tc_root/setpoint] - [hval $tc_root/sensor/value]) <= [hval $tc_root/tolerance]} {
|
|
sct driving 0
|
|
sct print "drivestatus: idle"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc setSpeed {tc_root nextState cmd} {
|
|
debug_log "setSpeed $tc_root $nextState $cmd [sct]=[sct target] [hget [sct]]"
|
|
set speed [sct target]
|
|
set cmd "STS[format %04X [expr {int($speed)}]]"
|
|
debug_log "sct send $cmd"
|
|
sct send $cmd
|
|
return $nextState
|
|
}
|
|
|
|
proc rdSpeed {tc_root} {
|
|
debug_log "rdSpeed [sct] [sct result]"
|
|
set data [sct result]
|
|
switch -glob -- $data {
|
|
"ASCERR:*" {
|
|
sct geterror $data
|
|
}
|
|
default {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set flist [split $data " "]
|
|
if {[llength $flist] != 2} {
|
|
sct geterror "Field error: expected two fields, received $data"
|
|
return idle
|
|
}
|
|
set data [lindex $flist 0]
|
|
set stts [lindex $flist 1]
|
|
if {[string length $stts] != 4} {
|
|
sct geterror "Length error: expected RSxx but received $data"
|
|
} elseif {[string range $stts 0 1] != "RS"} {
|
|
sct geterror "Unexpected status: expected RSxx but received $stts"
|
|
} elseif {![string is xdigit [string range $stts 2 3]]} {
|
|
sct geterror "Hexadecimal error: expected RSxx but received $data"
|
|
} elseif {[string length $data] != 7} {
|
|
sct geterror "Length error: expected SRRxxxx but received $data"
|
|
} elseif {[string range $data 0 2] != "SRR"} {
|
|
sct geterror "Unexpected response: expected SRRxxxx but received $data"
|
|
} elseif {![string is xdigit [string range $data 3 6]]} {
|
|
sct geterror "Hexadecimal error: expected SRRxxxx but received $data"
|
|
} else {
|
|
debug_log "scan [string range $data 3 6] %4x data"
|
|
set rslt [scan [string range $data 3 6] %4x data]
|
|
debug_log "scan result rslt=$rslt, data=$data, oldval=[sct oldval]"
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdPower {tc_root} {
|
|
debug_log "rdPower [sct] [sct result]"
|
|
set data [sct result]
|
|
switch -glob -- $data {
|
|
"ASCERR:*" {
|
|
sct geterror $data
|
|
}
|
|
default {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set flist [split $data " "]
|
|
if {[llength $flist] != 2} {
|
|
sct geterror "Field error: expected two fields, received $data"
|
|
return idle
|
|
}
|
|
set data [lindex $flist 0]
|
|
set stts [lindex $flist 1]
|
|
if {[string length $stts] != 4} {
|
|
sct geterror "Length error: expected RSxx but received $data"
|
|
} elseif {[string range $stts 0 1] != "RS"} {
|
|
sct geterror "Unexpected status: expected RSxx but received $stts"
|
|
} elseif {![string is xdigit [string range $stts 2 3]]} {
|
|
sct geterror "Hexadecimal error: expected RSxx but received $data"
|
|
} elseif {[string length $data] != 5} {
|
|
sct geterror "Length error: expected SRCxx but received $data"
|
|
} elseif {[string range $data 0 2] != "SRC"} {
|
|
sct geterror "Unexpected response: expected SRCxx but received $data"
|
|
} elseif {![string is xdigit [string range $data 3 4]]} {
|
|
sct geterror "Hexadecimal error: expected SRCxx but received $data"
|
|
} else {
|
|
debug_log "scan [string range $data 3 4] %4x data"
|
|
set rslt [scan [string range $data 3 4] %4x data]
|
|
set data [expr {$data - 0x80}]
|
|
debug_log "scan result rslt=$rslt, data=$data, oldval=[sct oldval]"
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdTower {tc_root} {
|
|
debug_log "rdTower [sct] [sct result]"
|
|
set data [sct result]
|
|
switch -glob -- $data {
|
|
"ASCERR:*" {
|
|
sct geterror $data
|
|
}
|
|
default {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set flist [split $data " "]
|
|
if {[llength $flist] != 2} {
|
|
sct geterror "Field error: expected two fields, received $data"
|
|
return idle
|
|
}
|
|
set data [lindex $flist 0]
|
|
set stts [lindex $flist 1]
|
|
if {[string length $stts] != 4} {
|
|
sct geterror "Length error: expected RSxx but received $data"
|
|
} elseif {[string range $stts 0 1] != "RS"} {
|
|
sct geterror "Unexpected status: expected RSxx but received $stts"
|
|
} elseif {![string is xdigit [string range $stts 2 3]]} {
|
|
sct geterror "Hexadecimal error: expected RSxx but received $data"
|
|
} elseif {[string length $data] != 5} {
|
|
sct geterror "Length error: expected SRDxx but received $data"
|
|
} elseif {[string range $data 0 2] != "SRD"} {
|
|
sct geterror "Unexpected response: expected SRDxx but received $data"
|
|
} elseif {[string range $data 3 4] != "00" && [string range $data 3 4] != "10"} {
|
|
sct geterror "Data error: expected SRD00 or SRD10 but received $data"
|
|
} else {
|
|
set data [string range $data 3 4]
|
|
if {$data == "10"} {
|
|
set data "1"
|
|
}
|
|
debug_log "Tower data=$data, oldval=[sct oldval]"
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc rdVisc {tc_root} {
|
|
debug_log "rdVisc [sct] [sct result]"
|
|
set data [sct result]
|
|
switch -glob -- $data {
|
|
"ASCERR:*" {
|
|
sct geterror $data
|
|
}
|
|
default {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set flist [split $data " "]
|
|
if {[llength $flist] != 2} {
|
|
sct geterror "Field error: expected two fields, received $data"
|
|
return idle
|
|
}
|
|
set data [lindex $flist 0]
|
|
set stts [lindex $flist 1]
|
|
if {[string length $stts] != 4} {
|
|
sct geterror "Length error: expected RSxx but received $data"
|
|
} elseif {[string range $stts 0 1] != "RS"} {
|
|
sct geterror "Unexpected status: expected RSxx but received $stts"
|
|
} elseif {![string is xdigit [string range $stts 2 3]]} {
|
|
sct geterror "Hexadecimal error: expected RSxx but received $data"
|
|
} elseif {[string length $data] != 9} {
|
|
sct geterror "Length error: expected SRIxxxxxx but received $data"
|
|
} elseif {[string range $data 0 2] != "SRI"} {
|
|
sct geterror "Unexpected response: expected SRIxxxxxx but received $data"
|
|
} elseif {![string is xdigit [string range $data 3 8]]} {
|
|
sct geterror "Hexadecimal error: expected SRIxxxxxx but received $data"
|
|
} else {
|
|
debug_log "scan [string range $data 3 8] %6x data"
|
|
set rslt [scan [string range $data 3 8] %6x data]
|
|
if {$data > 0x7FFFFF} {
|
|
set data [expr {$data - 0x1000000}]
|
|
}
|
|
debug_log "scan result rslt=$rslt, data=$data, oldval=[sct oldval]"
|
|
if {"$data" ne "[sct oldval]"} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#
|
|
# Send a command for the state/substate
|
|
#
|
|
proc getState {tc_root nextState} {
|
|
debug_log "getState $tc_root $nextState sct=[sct] state=[sct my_state] substate=[sct my_substate]"
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
if {[ catch {
|
|
set my_state [sct my_state]
|
|
set my_substate [sct my_substate]
|
|
if {$my_state == "STATE_INIT"} {
|
|
if {$my_substate == 0} {
|
|
set my_cmd "SEC04"
|
|
} elseif {$my_substate == 1} {
|
|
set my_cmd "RSV"
|
|
} elseif {$my_substate == 2} {
|
|
set my_cmd "STT00FA"
|
|
}
|
|
} elseif {$my_state == "STATE_TEST"} {
|
|
set my_cmd "RD[sct last]"
|
|
} elseif {$my_state == "STATE_IDLE"} {
|
|
set my_cmd "RD000000"
|
|
} else {
|
|
sct my_state "STATE_INIT"
|
|
sct my_substate "0"
|
|
set my_cmd "SEC04"
|
|
}
|
|
sct send "$my_cmd"
|
|
} catch_message ]} {
|
|
debug_log "getState error: $catch_message"
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
##
|
|
# @brief Reads the current newport state and error messages.
|
|
proc rdState {tc_root} {
|
|
debug_log "rdState [sct] [sct result]"
|
|
set nextState "idle"
|
|
set data [sct result]
|
|
if {[string first "ASCERR:" $data] >=0} {
|
|
sct geterror $data
|
|
} elseif {[ catch {
|
|
set my_state [sct my_state]
|
|
set my_substate [sct my_substate]
|
|
if {$my_state == "STATE_INIT"} {
|
|
if {"$my_substate" == "0"} {
|
|
sct my_substate 1
|
|
} elseif {"$my_substate" == "1"} {
|
|
set parts [split [sct result] " "]
|
|
sct my_substate 2
|
|
} elseif {"$my_substate" == "2"} {
|
|
sct my_state "STATE_IDLE"
|
|
sct my_substate 0
|
|
} else {
|
|
sct my_substate 0
|
|
}
|
|
} elseif {$my_state == "STATE_IDLE"} {
|
|
set parts [split [sct result] " "]
|
|
if {[llength $parts] == 2} {
|
|
set data [lindex $parts 0]
|
|
set stts [lindex $parts 1]
|
|
if {"$stts" == "RD00"} {
|
|
debug_log "scan $data DR%6x%4x%6x%2x%4x%2x the_t the_c the_v the_e the_s the_r"
|
|
set rslt [scan $data "DR%6x%4x%6x%2x%4x%2x" the_t the_c the_v the_e the_s the_r]
|
|
debug_log "scan result rslt=$rslt, the_t=$the_t , the_c=$the_c , the_v=$the_v , the_e=$the_e , the_s=$the_s , the_r=$the_r"
|
|
if {$rslt == 6} {
|
|
# handle test start
|
|
if {$the_r != 0} {
|
|
sct test_time [clock seconds]
|
|
set file_name [hval $tc_root/profile]
|
|
debug_log "file: $file_name"
|
|
set file_name [file tail [file rootname $file_name]]
|
|
debug_log "file: $file_name"
|
|
set file_name "[file normalize "../log/${file_name}_[clock format [sct test_time] -format "%Y%m%d%H%M%S"]"]"
|
|
debug_log "file: ${file_name}"
|
|
sct datafile "${file_name}"
|
|
set f [open "[sct datafile].txt" "w"]
|
|
rva_datafile [ file tail [sct datafile] ]
|
|
puts $f "SRY[clock format [sct test_time] -format "%d%m%Y"]"
|
|
puts $f "SRO[clock format [sct test_time] -format "%H%M%S"]"
|
|
close $f
|
|
set f [open "[sct datafile].csv" "w"]
|
|
puts $f "Time,Temp,Visc,Heat,Speed"
|
|
close $f
|
|
sct my_state "STATE_TEST"
|
|
sct last "000000"
|
|
}
|
|
} else {
|
|
debug_log "Read Data format error: [sct result]"
|
|
}
|
|
} else {
|
|
debug_log "Read Data status error: [sct result]"
|
|
}
|
|
} else {
|
|
debug_log "Read Data response error: [sct result]"
|
|
}
|
|
} elseif {"$my_state" == "STATE_TEST"} {
|
|
set parts [split [sct result] " "]
|
|
if {[llength $parts] == 2} {
|
|
set data [lindex $parts 0]
|
|
set stts [lindex $parts 1]
|
|
if {"$stts" == "RD00"} {
|
|
debug_log "scan $data DR%6x%4x%6x%2x%4x%2x the_t the_c the_v the_e the_s the_r"
|
|
set rslt [scan $data "DR%6x%4x%6x%2x%4x%2x" the_t the_c the_v the_e the_s the_r]
|
|
debug_log "scan result rslt=$rslt, the_t=$the_t , the_c=$the_c , the_v=$the_v , the_e=$the_e , the_s=$the_s , the_r=$the_r"
|
|
if {$rslt == 6} {
|
|
# process the data and increment through list
|
|
if {"[string range $data 2 7]" ne "[sct last]"} {
|
|
sct last [string range $data 2 7]
|
|
# write last data
|
|
set f [open "[sct datafile].txt" "a"]
|
|
puts $f "$data"
|
|
close $f
|
|
set f [open "[sct datafile].csv" "a"]
|
|
set my_time [expr {[sct test_time] + int($the_t / 45.0)}]
|
|
set my_temp [expr {$the_c / 20.0}]
|
|
if {$the_v > 0x7FFFFF} {
|
|
set my_visc [expr {$the_v - 0x1000000}]
|
|
} else {
|
|
set my_visc [expr {$the_v}]
|
|
}
|
|
set my_heat [expr {$the_e - 0x80}]
|
|
set my_speed [expr {$the_s}]
|
|
puts $f "[clock format $my_time -format "%Y-%m-%d %H:%M:%S"],$my_temp,$my_visc,$my_heat,$my_speed"
|
|
close $f
|
|
set nextState "idle"
|
|
}
|
|
if {$the_r == 0} {
|
|
sct my_state "STATE_IDLE"
|
|
sct my_substate 0
|
|
} else {
|
|
}
|
|
} else {
|
|
debug_log "Read Data format error: [sct result]"
|
|
}
|
|
} else {
|
|
debug_log "Read Data status error: [sct result]"
|
|
}
|
|
} else {
|
|
debug_log "Read Data response error: [sct result]"
|
|
}
|
|
} else {
|
|
sct my_state "STATE_IDLE"
|
|
sct my_substate "0"
|
|
set nextState "idle"
|
|
}
|
|
} catch_message ]} {
|
|
debug_log "getState error: $catch_message"
|
|
}
|
|
|
|
if {[sct oldval] == "UNKNOWN"} {
|
|
rva_datafile "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
|
|
}
|
|
if {[sct my_state] != [sct oldval]} {
|
|
sct oldval [sct my_state]
|
|
sct update [sct my_state]
|
|
sct utime readtime
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
proc getHP {tc_root nextState cmd} {
|
|
set data [hval $tc_root/Loop1/power]
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
debug_log "getHP $tc_root $nextState $cmd [sct] $data"
|
|
return idle
|
|
}
|
|
|
|
proc getPV {tc_root nextState cmd} {
|
|
set data [hval $tc_root/Loop1/sensor]
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
debug_log "getPV $tc_root $nextState $cmd [sct] $data"
|
|
return idle
|
|
}
|
|
|
|
proc setPoint {tc_root nextState cmd} {
|
|
set par [sct target]
|
|
|
|
if {[sct writestatus] == "start"} {
|
|
# Called by drive adapter
|
|
hset $tc_root/status "busy"
|
|
hsetprop $tc_root/setpoint driving 1
|
|
}
|
|
sct send "$cmd $par"
|
|
debug_log "setPoint $cmd $par"
|
|
return $nextState
|
|
}
|
|
|
|
proc setProf {tc_root nextState cmd} {
|
|
debug_log "setProf $tc_root [sct] [sct target]"
|
|
sct print "setProf $tc_root [sct] [sct target]"
|
|
set my_index [sct index]
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
if {$my_index < 0} {
|
|
set lines [list]
|
|
if {[file exists "[sct target]"] && [file readable "[sct target]"]} {
|
|
sct print "opening [file normalize "[sct target]"]"
|
|
set f [open "[sct target]"]
|
|
sct idle_temp "UNKNOWN"
|
|
sct final_time "UNKNOWN"
|
|
sct load_status "UNKNOWN"
|
|
set dec_temp "UNKNOWN"
|
|
set dec_time "UNKNOWN"
|
|
while {1} {
|
|
set line [gets $f]
|
|
if {[eof $f]} {
|
|
close $f
|
|
break
|
|
}
|
|
set parts [split $line ","]
|
|
if {[llength $parts] == 4} {
|
|
set the_type [string toupper [lindex $parts 0]]
|
|
set the_time [lindex $parts 1]
|
|
set the_valu [lindex $parts 2]
|
|
set the_ramp [lindex $parts 3]
|
|
if {$the_type == "I"} {
|
|
set the_valu [expr {round($the_valu * 20.0)}]
|
|
set the_ramp [expr {round($the_ramp * 20.0)}]
|
|
} elseif {$the_type == "S"} {
|
|
} elseif {$the_type == "T"} {
|
|
set the_valu [expr {round($the_valu * 20.0)}]
|
|
set the_ramp [expr {round($the_ramp * 20.0 /45 * 32768)}]
|
|
} else {
|
|
sct geterror "Profile error: $line"
|
|
sct print "Profile error: $line"
|
|
close $f
|
|
return idle
|
|
}
|
|
set the_line [format "%02X" [llength $lines]]
|
|
set the_time [format "%06X" [expr {round($the_time * 45.0)}]]
|
|
set the_valu [format "%04X" $the_valu]
|
|
set the_ramp [string range [format "%04X" $the_ramp] end-3 end]
|
|
set old_line $line
|
|
set line "LT${the_line}${the_type}${the_time}${the_valu}${the_ramp}"
|
|
}
|
|
if {[string length $line] != 19} {
|
|
sct geterror "Profile error: $line"
|
|
sct print "Profile error: $line"
|
|
close $f
|
|
return idle
|
|
}
|
|
if {[string range $line 0 1] != "LT"} {
|
|
sct geterror "Profile error: $line"
|
|
sct print "Profile error: $line"
|
|
close $f
|
|
return idle
|
|
}
|
|
set rslt [scan $line "LT%2x%1s%6x%4x%4x" the_line the_type the_time the_valu the_ramp]
|
|
if {"$the_type" == "I"} {
|
|
set dec_temp [format "%.1f" [expr {$the_valu / 20.0}]]
|
|
}
|
|
set dec_time [expr {$the_time / 45.0}]
|
|
lappend lines $line
|
|
}
|
|
sct load_status "loading"
|
|
sct idle_temp $dec_temp
|
|
sct final_time $dec_time
|
|
sct profile_line_count [llength $lines]
|
|
set last_temp_index -1
|
|
for {set line_no 0} {$line_no < [llength $lines]} {incr line_no} {
|
|
set this_line [lindex $lines $line_no]
|
|
if {[string index $this_line 4] == "T"} {
|
|
sct print "Examining $this_line"
|
|
if {$last_temp_index >= 0} {
|
|
set last_line [lindex $lines $last_temp_index]
|
|
scan [string range $last_line 5 18] "%06x%04x%04x" last_time last_temp last_ramp
|
|
if {$last_ramp > 0x7FFF} {
|
|
set last_ramp [expr {$last_ramp - 0x10000}]
|
|
}
|
|
sct print "Last: time=[format "%6d" $last_time], temp=[format "%4d" $last_temp], ramp=$last_ramp"
|
|
scan [string range $this_line 5 18] "%06x%04x%04x" this_time this_temp this_ramp
|
|
if {$this_ramp > 0x7FFF} {
|
|
set this_ramp [expr {$this_ramp - 0x10000}]
|
|
}
|
|
sct print "This: time=[format "%6d" $this_time], temp=[format "%4d" $this_temp], ramp=$this_ramp"
|
|
if {($this_time != $last_time) && ($this_temp != $last_temp)} {
|
|
set the_ramp [expr {round(32768.0 * ($this_temp - $last_temp) / ($this_time - $last_time))}]
|
|
if {$the_ramp != $last_ramp} {
|
|
sct print "Changing Ramp from $last_ramp to $the_ramp"
|
|
set the_ramp [string range [format "%04X" $the_ramp] end-3 end]
|
|
set new_line "[string range $last_line 0 14]${the_ramp}"
|
|
lset lines $last_temp_index $new_line
|
|
} else {
|
|
sct print "Leaving Ramp from $last_ramp as $the_ramp"
|
|
}
|
|
}
|
|
}
|
|
set last_temp_index $line_no
|
|
}
|
|
}
|
|
for {set line_no 0} {$line_no < [llength $lines]} {incr line_no} {
|
|
set name profile_line_[format "%03d" $line_no]
|
|
set profile_line [lindex $lines $line_no]
|
|
sct $name $profile_line
|
|
}
|
|
sct oldval [sct target]
|
|
sct update [sct target]
|
|
sct utime readtime
|
|
} else {
|
|
sct geterror "file [sct target] is [file normalize "[sct target]"], exists: [file exists "[sct target]"], readable: [file readable "[sct target]"]"
|
|
sct print "file [sct target] is [file normalize "[sct target]"], exists: [file exists "[sct target]"], readable: [file readable "[sct target]"]"
|
|
return idle
|
|
}
|
|
sct send "RTC"
|
|
} else {
|
|
set name profile_line_[format "%03d" $my_index]
|
|
set my_item "[sct $name]"
|
|
sct send "$my_item"
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
proc ackProf {tc_root} {
|
|
debug_log "ackProf $tc_root [sct result]"
|
|
sct print "ackProf $tc_root [sct] [sct result]"
|
|
sct print "Value: [hval [sct]]"
|
|
sct print "Props: [hlistprop [sct]]"
|
|
set my_index [sct index]
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
if {$my_index < 0} {
|
|
# TODO Check response to RTC
|
|
sct print "RTC=>[sct result]"
|
|
} else {
|
|
# TODO Check response to LT...
|
|
sct print "LT=>[sct result]"
|
|
}
|
|
set my_index [expr {$my_index + 1}]
|
|
sct index $my_index
|
|
if {$my_index >= [sct profile_line_count]} {
|
|
sct index -1
|
|
sct load_status "loaded"
|
|
return "idle"
|
|
}
|
|
return "write"
|
|
}
|
|
|
|
proc setTest {tc_root nextState cmd} {
|
|
debug_log "setTest $tc_root [sct] [sct target]"
|
|
sct print "setTest $tc_root [sct] [sct target]"
|
|
set data [sct target]
|
|
if {$data != 0} {
|
|
sct update 0
|
|
sct send "SEC01"
|
|
sct print "sct send \"SEC01\""
|
|
} else {
|
|
sct update 0
|
|
sct utime readtime
|
|
sct send "RD000000"
|
|
#sct print "sct send \"RD000000\""
|
|
sct last "000000"
|
|
}
|
|
return $nextState
|
|
}
|
|
|
|
proc ackTest {tc_root} {
|
|
debug_log "ackTest $tc_root [sct] [sct target]"
|
|
set data [sct result]
|
|
set ts [string range $data 2 7]
|
|
if {[sct target] != 0} {
|
|
return idle
|
|
}
|
|
if {$ts == [sct last]} {
|
|
return idle
|
|
} else {
|
|
sct print "[lindex [split "$data" " "] 0]"
|
|
sct last $ts
|
|
sct send "RD$ts"
|
|
#sct print "sct send \"RD$ts\""
|
|
return ackTest
|
|
}
|
|
}
|
|
|
|
proc rdTest {tc_root} {
|
|
debug_log "rdTest [sct] [sct result]"
|
|
set data [sct result]
|
|
switch -glob -- $data {
|
|
"ASCERR:*" {
|
|
sct geterror $data
|
|
}
|
|
default {
|
|
if { [hpropexists [sct] geterror] } {
|
|
hdelprop [sct] geterror
|
|
}
|
|
set flist [split $data " "]
|
|
if {[llength $flist] != 2} {
|
|
sct geterror "Field error: expected two fields, received $data"
|
|
return idle
|
|
}
|
|
set data [lindex $flist 0]
|
|
set stts [lindex $flist 1]
|
|
if {[string length $stts] != 4} {
|
|
sct geterror "Length error: expected RDxx but received $data"
|
|
} elseif {[string range $stts 0 1] != "RD"} {
|
|
sct geterror "Unexpected status: expected RDxx but received $stts"
|
|
} elseif {![string is xdigit [string range $stts 2 3]]} {
|
|
sct geterror "Hexadecimal error: expected RDxx but received $data"
|
|
} elseif {[string length $data] != 26} {
|
|
sct geterror "Length error: expected DRttttttccccvvvvvveessssrr but received $data"
|
|
} elseif {[string range $data 0 1] != "DR"} {
|
|
sct geterror "Unexpected response: expected DRttttttccccvvvvvveessssrr but received $data"
|
|
} elseif {![string is xdigit [string range $data 24 25]]} {
|
|
sct geterror "Hexadecimal error: expected DRttttttccccvvvvvveessssrr but received $data"
|
|
} else {
|
|
debug_log "scan $data DR%6x%4x%6x%2x%4x%2x the_t the_c the_v the_e the_s the_r"
|
|
set rslt [scan $data "DR%6x%4x%6x%2x%4x%2x" the_t the_c the_v the_e the_s the_r]
|
|
debug_log "scan result rslt=$rslt, the_t=$the_t , the_c=$the_c , the_v=$the_v , the_e=$the_e , the_s=$the_s , the_r=$the_r"
|
|
if {$rslt == 6} {
|
|
# handle RVA indication of test start
|
|
if {$the_r != 0} {
|
|
set data 1
|
|
} else {
|
|
set data 0
|
|
}
|
|
if {$data != [sct oldval]} {
|
|
sct oldval $data
|
|
sct update $data
|
|
sct utime readtime
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc setRest {tc_root nextState cmd} {
|
|
debug_log "setRest $tc_root [sct] [sct target]"
|
|
sct print "setRest $tc_root [sct] [sct target]"
|
|
hsetprop $tc_root/device_state my_state "STATE_INIT"
|
|
hsetprop $tc_root/device_state my_substate "0"
|
|
hsetprop $tc_root/setpoint driving "0"
|
|
# TODO What else needs to be set
|
|
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: $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 noResponse {} {
|
|
return idle
|
|
}
|
|
|
|
# check that a target is within allowable limits
|
|
proc check {tc_root} {
|
|
set setpoint [sct target]
|
|
set lolimit [hval $tc_root/lowerlimit]
|
|
set hilimit [hval $tc_root/upperlimit]
|
|
if {$setpoint < $lolimit || $setpoint > $hilimit} {
|
|
error "setpoint violates limits"
|
|
}
|
|
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"
|
|
set temp [hval $tc_root/sensor/value]
|
|
set lotemp [hval $tc_root/subtemp_warnlimit]
|
|
set hitemp [hval $tc_root/overtemp_warnlimit]
|
|
if { $temp < $lotemp || $temp > $hitemp} {
|
|
hset $tc_root/emon/isintol 0
|
|
return 0
|
|
} else {
|
|
set timeout [hval $tc_root/tolerance/settletime]
|
|
if { ($currtime - $timecheck) > $timeout } {
|
|
hset $tc_root/emon/isintol 1
|
|
}
|
|
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} {
|
|
debug_log "drivestatus $tc_root driving=[sct driving]"
|
|
if {[sct driving]} {
|
|
# TODO handle end of drive command
|
|
if {abs([hval $tc_root/setpoint] - [hval $tc_root/sensor/value]) <= [hval $tc_root/tolerance]} {
|
|
sct driving 0
|
|
sct print "drivestatus: idle"
|
|
return idle
|
|
}
|
|
return busy
|
|
}
|
|
sct print "drivestatus: idle"
|
|
return idle
|
|
}
|
|
|
|
proc halt {tc_root} {
|
|
debug_log "halt $tc_root"
|
|
hset $tc_root/setpoint [hval $tc_root/sensor/value]
|
|
hsetprop $tc_root/setpoint driving 0
|
|
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\
|
|
drivable dataType permission rdCmd rdFunc wrCmd\
|
|
wrFunc allowedValues klass} {
|
|
|
|
set catch_status [ catch {
|
|
# set ns ::scobj::ls460
|
|
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} {
|
|
set parts [split "$rdFunc" "."]
|
|
if { [llength $parts] == 2 } {
|
|
set func_name [lindex $parts 0]
|
|
set next_state [lindex $parts 1]
|
|
hsetprop $nodeName read ${ns}::$func_name $scobj_hpath $next_state $rdCmd
|
|
hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath
|
|
} else {
|
|
set func_name "getValue"
|
|
hsetprop $nodeName read ${ns}::$func_name $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
|
|
} else {
|
|
hsetprop $nodeName driving 0
|
|
}
|
|
} message ]
|
|
if {$catch_status != 0} {
|
|
return -code error "in createNode $message"
|
|
}
|
|
return OK
|
|
}
|
|
|
|
proc mk_sct_newport_rva {sct_controller klass tempobj tol} {
|
|
set catch_status [ catch {
|
|
set ns "[namespace current]"
|
|
|
|
sicslist setatt $tempobj klass $klass
|
|
sicslist setatt $tempobj long_name $tempobj
|
|
|
|
::utility::mkVar rva_datafile text user rva_datafile true $klass true true
|
|
sicslist setatt rva_datafile link data_set
|
|
|
|
set scobj_hpath /sics/$tempobj
|
|
|
|
set deviceCommand {\
|
|
sensor value 1 0 0 float user {RST} {rdTemp} {0} {} {}\
|
|
{} setpoint 0 1 1 float user {} {} {0} {setTemp.chkWrite} {}\
|
|
{} speed 1 1 0 float user {RSR} {rdSpeed} {0} {setSpeed.chkWrite} {}\
|
|
{} power 1 0 0 float internal {RSC} {rdPower} {0} {} {}\
|
|
{} tower 1 0 0 float internal {RSD} {rdTower} {0} {} {}\
|
|
{} viscosity 1 0 0 float internal {RSI} {rdVisc} {0} {} {}\
|
|
{} profile 0 1 0 text user {} {} {0} {setProf.ackProf} {}\
|
|
{} test 1 1 0 text user {RD000000} {rdTest} {0} {setTest.ackTest} {}\
|
|
{} reset 0 1 0 text user {} {} {0} {setRest} {}\
|
|
}
|
|
|
|
hfactory $scobj_hpath/sensor plain spy none
|
|
hfactory $scobj_hpath/Loop1 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
|
|
}
|
|
|
|
hsetprop $scobj_hpath/sensor/value lowerlimit 0
|
|
hsetprop $scobj_hpath/sensor/value upperlimit 140
|
|
hsetprop $scobj_hpath/sensor/value units "C"
|
|
|
|
hfactory $scobj_hpath/apply_tolerance plain user int
|
|
hsetprop $scobj_hpath/apply_tolerance values 0,1
|
|
hset $scobj_hpath/apply_tolerance 1
|
|
|
|
hfactory $scobj_hpath/tolerance plain user float
|
|
hsetprop $scobj_hpath/tolerance units "C"
|
|
hfactory $scobj_hpath/tolerance/settletime plain user float
|
|
hset $scobj_hpath/tolerance/settletime 5.0
|
|
hsetprop $scobj_hpath/tolerance/settletime units "s"
|
|
hset $scobj_hpath/tolerance $tol
|
|
|
|
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"
|
|
hsetprop $scobj_hpath/device_state profile_table ""
|
|
|
|
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 ""
|
|
|
|
hfactory $scobj_hpath/lowerlimit plain mugger float
|
|
hsetprop $scobj_hpath/lowerlimit units "C"
|
|
hset $scobj_hpath/lowerlimit 0
|
|
|
|
hfactory $scobj_hpath/upperlimit plain mugger float
|
|
hsetprop $scobj_hpath/upperlimit units "C"
|
|
hset $scobj_hpath/upperlimit 140
|
|
|
|
hfactory $scobj_hpath/emon plain spy none
|
|
hfactory $scobj_hpath/emon/monmode plain user text
|
|
hsetprop $scobj_hpath/emon/monmode values idle,drive,monitor,error
|
|
hset $scobj_hpath/emon/monmode "idle"
|
|
hfactory $scobj_hpath/emon/isintol plain user int
|
|
hset $scobj_hpath/emon/isintol 1
|
|
hfactory $scobj_hpath/emon/errhandler plain user text
|
|
hset $scobj_hpath/emon/errhandler "pause"
|
|
|
|
hsetprop $scobj_hpath/profile index -1
|
|
hsetprop $scobj_hpath/profile load_status "UNKNOWN"
|
|
|
|
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
|
|
}
|
|
|
|
hsetprop $scobj_hpath klass $klass
|
|
::scobj::hinitprops $tempobj
|
|
::scobj::set_required_props $scobj_hpath
|
|
foreach {rootpath hpath klass priv} "
|
|
$scobj_hpath sensor NXsensor spy
|
|
$scobj_hpath sensor/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 type part
|
|
hsetprop $scobj_hpath/sensor type part
|
|
hsetprop $scobj_hpath/sensor/value nxalias tc1_sensor_value
|
|
hsetprop $scobj_hpath/sensor/value mutable true
|
|
hsetprop $scobj_hpath/sensor/value sdsinfo ::nexus::scobj::sdsinfo
|
|
|
|
hsetprop $scobj_hpath privilege spy
|
|
::scobj::hinitprops $tempobj setpoint
|
|
hsetprop $scobj_hpath/setpoint data true
|
|
if {[SplitReply [environment_simulation]]=="false"} {
|
|
ansto_makesctdrive ${tempobj}_driveable $scobj_hpath/setpoint $scobj_hpath/sensor/value $sct_controller
|
|
}
|
|
} catch_message ]
|
|
if {$catch_status != 0} {
|
|
return -code error $catch_message
|
|
}
|
|
}
|
|
namespace export mk_sct_newport_rva
|
|
}
|
|
|
|
##
|
|
# @brief Create a Newport Rapid Visco Analyzer
|
|
#
|
|
# @param name, the name of the temperature controller (eg tc1)
|
|
# @param IP, the IP address of the device, this can be a hostname, (eg ca5-kowari)
|
|
# @param port, the IP protocol port number of the device (502 for modbus)
|
|
# @param _tol (optional), this is the initial tolerance setting
|
|
proc add_newport_rva {name IP port {_tol 1.0}} {
|
|
set fd [open "../log/newport_rva.log" a]
|
|
if {[SplitReply [environment_simulation]]=="false"} {
|
|
puts $fd "makesctcontroller sct_${name} newport ${IP}:$port"
|
|
makesctcontroller sct_${name} newport ${IP}:$port
|
|
}
|
|
puts $fd "mk_sct_newport_rva sct_${name} environment $name $_tol"
|
|
mk_sct_newport_rva sct_${name} environment $name $_tol
|
|
# puts $fd "makesctemon $name /sics/$name/emon/monmode /sics/$name/emon/isintol /sics/$name/emon/errhandler"
|
|
# makesctemon $name /sics/$name/emon/monmode /sics/$name/emon/isintol /sics/$name/emon/errhandler
|
|
close $fd
|
|
}
|
|
|
|
clientput "file evaluation of sct_newport_rva.tcl"
|
|
set fd [open "../log/newport_rva.log" w]
|
|
puts $fd "file evaluation of sct_newport_rva.tcl"
|
|
close $fd
|
|
|
|
namespace import ::scobj::newport_rva::*
|