From 81605a11a1b044a8a236465ffb6b2165ed04dd31 Mon Sep 17 00:00:00 2001 From: Douglas Clowes Date: Mon, 3 Sep 2012 13:37:30 +1000 Subject: [PATCH] Driver for the Oxford Mercury Temperature Controller (WIP) r3732 | dcl | 2012-09-03 13:37:30 +1000 (Mon, 03 Sep 2012) | 1 line --- .../temperature/sct_oxford_mercury.tcl | 765 ++++++++++++++++++ 1 file changed, 765 insertions(+) create mode 100644 site_ansto/instrument/config/environment/temperature/sct_oxford_mercury.tcl diff --git a/site_ansto/instrument/config/environment/temperature/sct_oxford_mercury.tcl b/site_ansto/instrument/config/environment/temperature/sct_oxford_mercury.tcl new file mode 100644 index 00000000..786496ae --- /dev/null +++ b/site_ansto/instrument/config/environment/temperature/sct_oxford_mercury.tcl @@ -0,0 +1,765 @@ +# vim: ts=8 sw=2 sta sts=2 et ai si +# This is a template driver for a mercury temperaure controller from Oxford Instruments +# +# Author: Douglas Clowes +# Date: August 2012 +# +if { "[lindex [split [info nameofexecutable] "/"] end]" == "tclsh"} { +# This block is to suppress spurious error/warning messages when loaded in Nagelfar + set catch_status [ catch { + puts "TCLSH" + proc environment_simulation {} { return "" } + proc SplitReply {str} { return "" } + proc makesctcontroller {args} { } + proc MakeSICSObj {args} { } + proc sicslist {args} { } + proc hfactory {args} { } + proc hdelprop {args} { } + proc hsetprop {args} { } + proc hgetprop {args} { } + proc hpropexists {args} { } + proc hlistprop {args} { } + proc hset {args} { } + proc hget {args} { } + proc hval {args} { } + proc hinfo {args} { } + proc hlist {args} { } + proc sct {args} { } + proc debug_log {args} { } + proc pathname {args} { } + proc basename {args} { } + proc channel {args} { } + proc ns {args} { } + } catch_message ] + if {$catch_status != 0} { + puts "error in main $catch_message" + return -code error "in main $catch_message" + } +} + +set vendor "oxford" +set device "mercury" + +namespace eval ::scobj::[set vendor]_[set device] { + proc ns {} { + return "[namespace current]" + } + # All of this takes place in a namespace based on the vendor and device + # Debug prints and vendor/device save + puts "Namespace: [namespace current]" + puts "Vendor:[set vendor]" + puts "Device:[set device]" + set [namespace current]::vendor [set ::vendor] + set [namespace current]::device [set ::device] + set [namespace current]::ven_dev "[set ::vendor]_[set ::device]" + puts "[namespace current]::vendor [set [namespace current]::vendor]" + puts "[namespace current]::device [set [namespace current]::device]" + puts "[namespace current]::ven_dev [set [namespace current]::ven_dev]" + + proc debug_log {debug_level arg_string} { + # write a timestamped string message to a log file for debugging + set debug_threshold 0 + if {$debug_level >= $debug_threshold} { + set fd [open "[set [namespace current]::log_file]" "a"] + set line "[clock format [clock seconds] -format "%T"] $arg_string" + puts $fd "$line" + puts "debug_log $line" + close $fd + } + } + + proc channel {arg} { + # strip the trailing digits from the arg and return them as a string + set result 0 + for { set i 0 } { $i < [string length $arg] } { incr i } { + if { ! [string match {[0-9]} [string index $arg end-$i]] } { + break + } + set result [string range "$arg" end-$i end] + } + debug_log 1 "Extract channel $result from argument $arg" + return $result + } + proc basename {node} { + set point [string last "/" $node] + if { $point < 0 } { + return $node + } else { + incr point + return "[string range $node $point end]" + } + } + proc pathname {node} { + set point [string last "/" $node] + if { $point < 0 } { + return "" + } else { + incr point -1 + return "[string range $node 0 $point]" + } + return "[join [lrange [split $node '/'] 0 end-1] '/']" + } + + proc setValue {tc_root nextState cmd} { + # send a command to set a value + debug_log 1 "setValue tc_root=$tc_root sct=[sct] $cmd [sct target]" + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + set par [sct target] + if { "$cmd" == "XXXX" } { + set command "$cmd $par;$cmd?" + } else { + set command "$cmd $par" + } + + sct send "$command" + return $nextState + } + + proc chkWrite {tc_root} { + # process the response to the write + # - not all devices will respond to writes + set data [sct result] + debug_log 1 "chkWrite tc_root=$tc_root sct=[sct] resp=$data" + if {[string equal -nocase -length 7 $data "ASCERR:"]} { + # the protocol driver has reported an error + sct geterror "$data" + } elseif {[string equal -nocase -length 1 $data "?"]} { + # the device has reported an error + sct geterror "Error: $data" + } else { + # the write was successful, record the data + set data [sct target] + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + debug_log 1 "chkWrite new data for $tc_root [sct] result=$data" + } + } + return idle + } + + proc noResponse {tc_root} { + set data "[sct result]" + debug_log 1 "noResponse tc_root=$tc_root sct=[sct] resp=$data" + return idle + } + + proc getValue {tc_root nextState cmd} { + # send a command to request a value + debug_log 1 "getValue tc_root=$tc_root sct=[sct] $cmd" + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + if { [string equal -nocase -length 4 "$cmd" "XXXX"] } { + set cmd "$cmd [channel [pathname [sct]]]" + } + debug_log 1 "getValue sct send $cmd" + sct send "$cmd" + return $nextState + } + + proc rdValue {tc_root} { + # process the received response to the read request + debug_log 1 "[ns]::rdValue tc_root=$tc_root sct=[sct] result=[sct result]" + set data [sct result] + if {[string equal -nocase -length 7 $data "ASCERR:"]} { + # the protocol driver has reported an error + sct geterror "$data" + } elseif {[string equal -nocase -length 1 $data "?"]} { + # the device has reported an error + sct geterror "Error: $data" + } else { + if { [string equal -nocase [basename [sct]] "XXXX"] } { + return "idle" + } + if {$data != [sct oldval]} { + debug_log 1 "[sct] changed to new:$data, from old:[sct oldval]" + sct oldval $data + sct update $data + sct utime readtime + } + } + return "idle" + } + + proc getTemp {tc_root nextState cmd} { + debug_log 1 "getTemp tc_root=$tc_root sct=[sct] $cmd" + if { ! [hpropexists [sct] my_state] } { + sct my_state 0 + } + if { [sct my_state] == 0 } { + set command "CSET?" + } else { + set command "RDGK? [sct channel]" + } + debug_log 1 "getTemp sct send $command" + sct send "$command" + return "$nextState" + } + + proc rdTemp {tc_root} { + debug_log 1 "rdTemp tc_root=$tc_root sct=[sct] result=[sct result]" + if { [sct my_state] == 0 } { + set response "[split [sct result] ","]" + sct channel [lindex $response 0] + sct filter [lindex $response 1] + sct my_state 1 + return "read" + } else { + set data "[sct result]" + if {$data != [sct oldval]} { + debug_log 1 "[sct] changed to new:$data, from old:[sct oldval]" + sct oldval $data + sct update $data + sct utime readtime + } + sct my_state 0 + return "idle" + } + } + + proc gtLoop {tc_root nextState cmd} { + debug_log 1 "gtLoop tc_root=$tc_root sct=[sct] nextState=$nextState cmd=$cmd" + debug_log 1 "gtLoop tc_root=$tc_root pathname=[pathname [sct]] basename=[basename [sct]]" + if { ! [hpropexists [sct] my_state] } { + debug_log 1 "gtLoop setting my_state to zero because it doesn't exist" + sct my_state 0 + } + if { [sct my_state] == 0 } { + set command "RAMP?" + } else { + set command "SETP?" + } + debug_log 1 "gtLoop sct=[sct] command=$command" + sct send "$command" + return "$nextState" + return idle + } + + proc rdLoop {tc_root} { + debug_log 1 "rdLoop tc_root=$tc_root sct=[sct] result=[sct result]" + debug_log 1 "rdLoop tc_root=$tc_root pathname=[pathname [sct]] basename=[basename [sct]]" + set nextState "read" + if { [sct my_state] == 0 } { + debug_log 1 "rdLoop sct=[sct] RAMP - result=[sct result]" + set nextState "read" + } else { + debug_log 1 "rdLoop sct=[sct] SETP - result=[sct result]" + set nextState "idle" + sct my_state -1 + } + sct my_state "[expr {[sct my_state] + 1}]" + return $nextState + } + + proc wrLoop {tc_root nextState cmd} { + debug_log 1 "wrLoop tc_root=$tc_root sct=[sct] nextState=$nextState cmd=$cmd" + if { ! [hpropexists [sct] my_state] } { + debug_log 1 "wrLoop setting my_state to zero because it doesn't exist" + sct my_state 0 + } + if { [sct writestatus] == "start" } { + debug_log 1 "wrLoop setting my_state to zero because writestatus is [sct writestatus]" + sct my_state 0 + } + debug_log 1 "wrLoop target=[sct target] writestatus=[sct writestatus] my_state=[sct my_state]" + if { [sct my_state] == 0 } { + set my_rate [hval [sct]/ramp_rate] + if { $my_rate > 0.0 } { + set command "RAMP 0,0;RAMP?" + } else { + set command "RAMP 1,$my_rate;RAMP?" + } + } else { + set command "SETP [hval [sct]/setpoint];SETP?" + } + debug_log 1 "wrLoop sct=[sct] command=$command" + sct send "$command" + return "$nextState" + } + + proc ckLoop {tc_root} { + debug_log 1 "ckLoop tc_root=$tc_root sct=[sct] result=[sct result]" + debug_log 1 "ckLoop target=[sct target] writestatus=[sct writestatus] my_state=[sct my_state]" + set nextState "write" + if { [sct my_state] == 0 } { + debug_log 1 "ckLoop sct=[sct] RAMP - result=[sct result]" + [ns]::rdValue $tc_root + set nextState "write" + } else { + debug_log 1 "ckLoop sct=[sct] SETP - result=[sct result]" + [ns]::rdValue $tc_root + sct my_state -1 + set nextState "idle" + } + sct my_state "[expr {[sct my_state] + 1}]" + return $nextState + } + + ## + # @brief getState() sends commands/requests to the device under control + # + # @param tc_root the path to the device_state node + # @param nextState the next sct state (rdState) + # @param cmd empty argument + # + # @return the next sct state (rdState) + # + proc getState {tc_root nextState cmd} { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + debug_log 1 "getState $tc_root sct=[sct] state=[hval [sct]] substate=[sct substate] next=$nextState" + set my_state [hval [sct]] + set my_substate [sct substate] + if {$my_state == "STATE_INIT"} { + if { $my_substate == 0 } { + set command "*IDN?" + } elseif { $my_substate == 1 } { + set command "*TST?" + } + } elseif { $my_state == "STATE_CURVE"} { + if { $my_substate == 0 } { + set my_substate 1000 + sct substate $my_substate + } + if { ($my_substate % 1000) == 0 } { + set command "CRVHDR? [expr {int($my_substate / 1000)}]" + } else { + set command "CRVPT? [expr {int($my_substate / 1000)}],[expr {($my_substate % 1000)}]" + } + } elseif { $my_state == "STATE_IDLE"} { + if { $my_substate == 0 } { + set command "*ESE?" + } elseif { $my_substate == 1 } { + set command "*ESR?" + } elseif { $my_substate == 2 } { + set command "*STB?" + } + } + debug_log 1 "getState sct send $command" + sct send $command + return "$nextState" + } + + ## + # @brief rdState() handles events from the device under control + # + # @param tc_root the path to the device_state node + # + proc rdState {tc_root} { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + debug_log 1 "rdState $tc_root sct=[sct] state=[hval [sct]] substate=[sct substate] response=\"[sct result]\"" + set nextState "read" + set my_state [hval [sct]] + set my_substate [sct substate] + if {$my_state == "STATE_INIT"} { + if { $my_substate == 0 } { # IDN + sct identity [sct result] + incr my_substate + } elseif { $my_substate == 1 } { + sct selftest [sct result] + incr my_substate + } + if { $my_substate > 1 } { + #hset [sct] "STATE_IDLE" + hset [sct] "STATE_CURVE" + set my_substate 0 + } + } elseif { $my_state == "STATE_CURVE"} { + if { ($my_substate % 1000) == 0 } { + debug_log 1 "Curve: [expr {$my_substate / 1000}] Header: [sct result]" + } else { + debug_log 1 "Curve: [expr {$my_substate / 1000}] Point: [expr {$my_substate % 1000}] Value: [sct result]" + set rslt [scan "[sct result]" "%f,%f" units temperature] + debug_log 1 "Curve: [expr {$my_substate / 1000}] Point: [expr {$my_substate % 1000}] Result: $rslt Units: $units Temp: $temperature" + if { $units == 0.0 && $temperature == 0.0 } { + set my_substate [expr { (($my_substate / 1000)) * 1000 + 999}] + } + } + if { ($my_substate % 1000) >= 200 } { + if { ($my_substate / 1000) >= 20 } { + hset [sct] "STATE_IDLE" + set my_substate 0 + } else { + set my_substate [expr { (($my_substate / 1000) + 1) * 1000 }] + } + } else { + set my_substate [expr { $my_substate + 1 }] + } + } elseif { $my_state == "STATE_IDLE"} { + if { $my_substate == 0 } { # ESE + sct the_ese [sct result] + incr my_substate + } elseif { $my_substate == 1 } { # ESR + sct the_esr [sct result] + incr my_substate + } elseif { $my_substate == 2 } { # STB + sct the_stb [sct result] + incr my_substate + } + if { $my_substate > 2 } { + set my_substate 0 + set nextState "idle" + } + } + sct substate $my_substate + if { $my_state != [hval [sct]] } { + debug_log 1 "device_state $my_state to [hval [sct]]" + } + return "$nextState" + } + + proc loadCurve_XXX {fname} { + sct print "loading curve [sct target] into [sct]" + set lines [list] + if {[file exists "[sct target]"] && [file readable "[sct target]"]} { + sct print "opening [file normalize "[sct target]"]" + set f [open "[sct target]"] + while {1} { + set line [gets $f] + if {[eof $f]} { + close $f + break + } + # TODO - parse lines and build database + } + close $f + } + } + + proc loadCurve_34A {fname} { + sct print "loading curve [sct target] into [sct]" + set profile_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]"] + while {1} { + set line [gets $f] + if {[eof $f]} { +#close $f + break + } + if { [string equal -nocase -length 5 "$line" "Name:"] } { + sct profile_name "[string range "$line" 6 end]" + } elseif { [string equal -nocase -length 14 "$line" "Serial number:"] } { + sct profile_number "[string range "$line" 15 end]" + } elseif { [string equal -nocase -length 7 "$line" "Format:"] } { + sct profile_format [lindex [split "$line"] 1] + } elseif { [string equal -nocase -length 6 "$line" "Limit:"] } { + sct profile_limit [lindex [split "$line"] 1] + } elseif { [string equal -nocase -length 12 "$line" "Coefficient:"] } { + sct profile_coeff [lindex [split "$line"] 1] + } elseif { [string equal -nocase -length 6 "$line" "Point "] } { + set rslt [scan "$line" "Point %d: %f,%f" idx r t] + if { $rslt != 3 } { + debug_log 1 "Profile error ($rslt) for: $line" + } else { + incr profile_index 1 + sct profile_line_[format "%03d" $profile_index] "[list $idx $r $t]" + debug_log 1 "Profile line $profile_index: [sct profile_line_[format "%03d" $profile_index]]" + } + } else { + debug_log 1 "Profile error unknown for: $line" + } + } + close $f + } + } + + proc ldCurve { tc_root nextState cmd } { + if { ! [hpropexists [sct] index] } { + sct index 0 + } + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + if { "[sct index]" <= 0 } { + [ns]::loadCurve_34A "[sct target]" + # TODO send curve header + debug_log 1 "Curve header: " + sct index [expr {[sct index] + 1}] + return write + } else { + # write curve to device + if { [hpropexists [sct] profile_line_[format "%03d" [sct index]]] } { + set profile_line [sct profile_line_[format "%03d" [sct index]]] + debug_log 1 "Profile line $profile_line" + } + return "$nextState" + } + return "$nextState" + } + + proc ackCurve {tc_root} { + sct index [expr {[sct index] + 1}] + if { [hpropexists [sct] profile_line_[format "%03d" [sct index]]] } { + return "write" + } + sct index 0 + return idle + } + + 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] { + [ns]::wrNode $tc_root/$node "$cmd" [expr {$level + 1}] + } + } + + proc wrTree {tc_root nextState cmd} { + debug_log 1 "wrTree root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" + sct print "$tc_root" + [ns]::wrNode $tc_root "[sct target]" 1 + return idle + } + + ## + # @brief createNode() creates a node for the given nodename with the properties given + # + # @param scobj_hpath string variable holding the path to the object's base node in sics (/sample/tc1) + # @param sct_controller name of the scriptcontext object (typically sct_xxx_yyy) + # @param cmdGroup subdirectory (below /sample/tc*/) in which the node is to be created + # @param varName name of the actual node typically representing one device command + # @param readable set to 1 if the node represents a query command, 0 if it is not + # @param writable set to 1 if the node represents a request for a change in settings sent to the device + # @param drivable if set to 1 it prepares the node to provide a drivable interface + # @param dataType data type of the node, must be one of none, int, float, text + # @param permission defines what user group may read/write to this node (is one of spy, user, manager) + # @param rdCmd actual device query command to be sent to the device + # @param rdFunc nextState Function to be called after the getValue function, typically rdValue() + # @param wrCmd actual device write command to be sent to the device + # @param wrFunc Function to be called to send the wrCmd to the device, typically setValue() + # @param allowedValues allowed values for the node data - does not permit other + # @param klass Nexus class name (?) + # @return OK + proc createNode {scobj_hpath sct_controller\ + cmdGroup varName\ + readable writable drivable\ + dataType permission\ + rdCmd rdFunc\ + wrCmd wrFunc\ + allowedValues klass} { + + set catch_status [ catch { + set ns "[ns]" + set nodeName "$scobj_hpath/$cmdGroup/$varName" + if {1 > [string length $cmdGroup]} { + set nodeName "$scobj_hpath/$varName" + } + debug_log 1 "Creating node $nodeName" + hfactory $nodeName plain $permission $dataType + if {$readable > 0} { + # the node is readable so set it up to be polled using the rdFunc + # rdFunc is getValueFunc.rdValueFunc with both explicit functions + # or rdValueFunc where "getValue" is the implied getValueFunc + set parts [split "$rdFunc" "."] + if { [llength $parts] == 2 } { + set func_name [lindex $parts 0] + set next_state [lindex $parts 1] + } else { + set func_name "getValue" + set next_state [lindex $parts 0] + } + hsetprop $nodeName read ${ns}::$func_name $scobj_hpath $next_state $rdCmd + hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath + # set the poll rate as a period in seconds + # TODO allow directly settable value in seconds + set poll_period 5 + if { $readable >= 0 && $readable <= 300 } { + set poll_period [expr {int($readable)}] + } + debug_log 1 "Registering node $nodeName for poll at $poll_period seconds" + $sct_controller poll $nodeName $poll_period + } + if {$writable == 1} { + # the node is writable so set it up to invoke a callback when written + # rdFunc is putValueFunc.chkWriteFunc with both explicit functions + # or putValueFunc where "noResponse" is the implied chkWriteFunc + set parts [split "$wrFunc" "."] + if { [llength $parts] == 2 } { + set func_name [lindex $parts 0] + set next_state [lindex $parts 1] + } else { + set func_name [lindex $parts 0] + set next_state "noResponse" + } + hsetprop $nodeName write ${ns}::$func_name $scobj_hpath $next_state $wrCmd + hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath + hsetprop $nodeName writestatus UNKNOWN + debug_log 1 "Registering node $nodeName for write callback" + $sct_controller write $nodeName + } + # Initialise the previous value to test against + switch -exact $dataType { + "none" { } + "int" { hsetprop $nodeName oldval -1 } + "float" { hsetprop $nodeName oldval -1.0 } + default { hsetprop $nodeName oldval UNKNOWN } + } + # Set the allowed values property + if {1 < [string length $allowedValues]} { + hsetprop $nodeName values $allowedValues + } + # Drive adapter interface + # TODO make it a separate function and pass in all this stuff + if {$drivable == 1} { + hsetprop $nodeName check ${ns}::check $scobj_hpath + hsetprop $nodeName driving 0 + hsetprop $nodeName checklimits ${ns}::check $scobj_hpath + hsetprop $nodeName checkstatus ${ns}::drivestatus $scobj_hpath + hsetprop $nodeName halt ${ns}::halt $scobj_hpath + } else { + hsetprop $nodeName driving 0 + } + } catch_message ] + if {$catch_status != 0} { + debug_log 5 "error in [ns]::createNode $catch_message" + return -code error "in [ns]::createNode $catch_message" + } + return OK + } + + proc mk_sct_driver {sct_controller the_klass the_name tol} { + debug_log 1 "mk_sct_driver $sct_controller $the_klass $the_name $tol" + set catch_status [ catch { + + MakeSICSObj $the_name SCT_OBJECT + sicslist setatt $the_name klass $the_klass + sicslist setatt $the_name long_name $the_name + + set scobj_hpath /sics/$the_name + + hfactory $scobj_hpath/Loop1 plain spy none + hfactory $scobj_hpath/Heater plain spy none + hfactory $scobj_hpath/Chan1 plain spy none + hfactory $scobj_hpath/Curve1 plain spy none + hfactory $scobj_hpath/Analog1 plain spy none + hfactory $scobj_hpath/Analog2 plain spy none + hfactory $scobj_hpath/Sensor plain spy none + + set deviceCommand {\ + Sensor value 1 0 0 float user {RDGK?} {rdValue} {} {} {}\ + {} setpoint 1 1 0 float user {SETP?} {rdValue} {SETP} {setValue} {}\ + {} device_state 1 0 0 text user {NULL} {getState.rdState} {} {} {}\ + {} alarm_reset 0 1 0 text user {} {} {ALMRST} {setValue} {}\ + {} device_reset 0 1 0 text user {} {} {*RST} {setValue} {}\ + {} mnmx_reset 0 1 0 text user {} {} {MNMXRST} {setValue} {}\ + {} Tree 0 1 0 text user {} {} {} {wrTree} {}\ + Loop1 ramp 1 1 0 text user {RAMP?} {rdValue} {RAMP} {setValue} {}\ + Loop1 ramp_enable 0 0 0 float user {} {} {} {} {}\ + Loop1 ramp_rate 0 0 0 float user {} {} {} {} {}\ + Loop1 setpoint 1 1 0 float user {SETP?} {rdValue} {SETP} {setValue} {}\ + Loop1 cset 1 1 0 text user {CSET?} {rdValue} {CSET} {setValue} {}\ + Loop1 sensor_channel 0 0 0 int user {} {} {} {} {}\ + Loop1 filter_enable 0 0 0 int user {} {} {} {} {}\ + Loop1 units 0 0 0 int user {} {} {} {} {}\ + Loop1 delay 0 0 0 int user {} {} {} {} {}\ + Loop1 current_or_power 0 0 0 int user {} {} {} {} {}\ + Loop1 htr_limit 0 0 0 int user {} {} {} {} {}\ + Loop1 htr_resistance 0 0 0 float user {} {} {} {} {}\ + Analog1 analog 1 1 0 text user {ANALOG?} {rdValue} {ANALOG} {setValue} {}\ + Analog1 aout 1 0 0 float user {AOUT?} {rdValue} {} {} {}\ + Analog2 analog 1 1 0 text user {ANALOG?} {rdValue} {ANALOG} {setValue} {}\ + Analog2 aout 1 0 0 float user {AOUT?} {rdValue} {} {} {}\ + Heater htr 1 0 0 float user {HTR?} {rdValue} {} {} {}\ + Heater htrrng 1 1 0 int user {HTRRNG?} {rdValue} {HTRRNG} {setValue} {}\ + Heater htrst 1 0 0 int user {HTRST?} {rdValue} {} {} {}\ + Chan1 alarm 1 1 0 text user {ALARM?} {rdValue} {ALARM} {setValue} {}\ + Chan1 alarmst 1 0 0 text user {ALARMST?} {rdValue} {} {} {}\ + Chan1 filter 1 1 0 text user {FILTER?} {rdValue} {FILTER} {setValue} {}\ + Chan1 inset 1 1 0 text user {INSET?} {rdValue} {INSET} {setValue} {}\ + Chan1 ldat 1 0 0 float user {LDAT?} {rdValue} {} {} {}\ + Chan1 linear 1 1 0 text user {LINEAR?} {rdValue} {LINEAR} {setValue} {}\ + Chan1 mdat 1 0 0 text user {MDAT?} {rdValue} {} {} {}\ + Chan1 mnmx 1 1 0 text user {MNMX?} {rdValue} {MNMX} {setValue} {}\ + Chan1 rdgk 1 0 0 float user {RDGK?} {rdValue} {} {} {}\ + Chan1 rdgpwr 1 0 0 float user {RDGPWR?} {rdValue} {} {} {}\ + Chan1 rdgr 1 0 0 float user {RDGR?} {rdValue} {} {} {}\ + Chan1 rdgrng 1 1 0 text user {RDGRNG?} {rdValue} {RDGRNG} {setValue} {}\ + Chan1 rdgst 1 0 0 int user {RDGST?} {rdValue} {} {} {}\ + Curve1 header 1 0 0 text user {CRVHDR?} {rdValue} {} {} {}\ + Curve1 profile 0 1 0 text user {} {} {XX} {ldCurve.ackCurve} {}\ + } + + foreach {cmdGroup varName\ + readable writable drivable\ + dataType permission\ + rdCmd rdFunc\ + wrCmd wrFunc\ + allowedValues} $deviceCommand { + [ns]::createNode $scobj_hpath $sct_controller\ + $cmdGroup $varName\ + $readable $writable $drivable\ + $dataType $permission\ + $rdCmd $rdFunc\ + $wrCmd $wrFunc\ + $allowedValues $the_klass + } + + hset $scobj_hpath/device_state "STATE_INIT" + hsetprop $scobj_hpath/device_state substate 0 + + } catch_message ] + if {$catch_status != 0} { + debug_log 5 "error in [ns]::mk_sct_driver $catch_message" + return -code error "in [ns]::mk_sct_driver $catch_message" + } + } + + proc add_[set vendor]_[set device] {the_name IP port {_tol 5.0}} { + set [ns]::log_file "/tmp/[set [ns]::ven_dev]_[set the_name].log" + debug_log 1 "add_[set [ns]::vendor]_[set [ns]::device] ${the_name} ${IP} ${port} ${_tol}" + puts "Namespace: [namespace current]" + puts "::vendor $::vendor" + puts "::device $::device" + puts "[namespace current]::vendor [set [namespace current]::vendor]" + puts "[namespace current]::device [set [namespace current]::device]" + puts "[namespace current]::ven_dev [set [namespace current]::ven_dev]" + puts "[namespace current]::log_file [set [namespace current]::log_file]" + if {[SplitReply [environment_simulation]]=="false"} { + debug_log 1 "makesctcontroller sct_${the_name} std ${IP}:${port}" + makesctcontroller sct_${the_name} std ${IP}:${port} "\r\n" + } + debug_log 1 "mk_sct_driver sct_${the_name} environment ${the_name} ${_tol}" + mk_sct_driver sct_${the_name} environment ${the_name} ${_tol} + } + + + namespace export add_[set vendor]_[set device] +} + +namespace import ::scobj::[set vendor]_[set device]::* + +# add_[set vendor]_[set device] "tc4" 127.0.0.1 7371 2.0 + +