From cd2dafceb3ded879ed61a9bf59a94bb932574e6d Mon Sep 17 00:00:00 2001 From: Douglas Clowes Date: Fri, 24 Jun 2011 13:01:08 +1000 Subject: [PATCH] Syringe Pump Driver for New Era Pump Systems Inc NE-1000 syringe pumps r3224 | dcl | 2011-06-24 13:01:08 +1000 (Fri, 24 Jun 2011) | 3 lines --- .../instrument/config/environment/sct_syr.tcl | 644 ++++++++++++++++++ 1 file changed, 644 insertions(+) create mode 100755 site_ansto/instrument/config/environment/sct_syr.tcl diff --git a/site_ansto/instrument/config/environment/sct_syr.tcl b/site_ansto/instrument/config/environment/sct_syr.tcl new file mode 100755 index 00000000..f9200a16 --- /dev/null +++ b/site_ansto/instrument/config/environment/sct_syr.tcl @@ -0,0 +1,644 @@ +# Define procs in ::scobj::xxx namespace +# MakeSICSObj $obj SCT_ +# 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" + } + set dev [getDev $tc_root] + 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" ] + debug_log "ValidateResponse: $rslt" + return $rslt + } elseif {[string equal -nocase -length 1 $data "?"]} { + set rslt [list 0 "$data" ] + debug_log "ValidateResponse: $rslt" + return $rslt + } else { + if {[string equal -nocase -length 1 $data "\002"]} { + set data [string range $data 1 end] + } + set addr [string range $data 0 2] + if {[string equal -length 1 $addr "0"]} { + set addr [string range $addr 1 end] + } + set stat [string range $data 2 3] + 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} { + + 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 {\ + Pump0 Run 0 1 1 1 1 text user {} {} {RUN} {wrRun} {}\ + Pump0 Cld 0 1 1 1 0 text user {} {} {CLD} {wrCld} {}\ + Pump0 Out 0 1 1 1 0 text user {} {} {OUT} {wrOut} {}\ + Pump0 Rat 1 1 1 1 0 text user {RAT} {rdRat} {RAT} {wrRat} {}\ + Pump0 Vol 1 1 1 1 0 text user {VOL} {rdVol} {VOL} {wrVol} {}\ + Pump0 Dir 1 1 1 1 0 text user {DIR} {rdDir} {DIR} {wrDir} {}\ + Pump0 Buz 1 1 1 1 0 text user {BUZ} {rdBuz} {BUZ} {wrBuz} {}\ + Pump0 Dis 1 0 1 1 0 text internal {DIS} {rdDis} {} {} {}\ + Pump0 In2 1 0 1 1 0 text internal {IN2} {rdInp} {} {} {}\ + Pump0 In3 1 0 1 1 0 text internal {IN3} {rdInp} {} {} {}\ + Pump0 In4 1 0 1 1 0 text internal {IN4} {rdInp} {} {} {}\ + Pump0 In6 1 0 1 1 0 text internal {IN6} {rdInp} {} {} {}\ + Pump0 Ver 1 0 1 1 0 text internal {VER} {rdVer} {} {} {}\ + Pump1 Run 0 1 1 1 1 text user {} {} {RUN} {wrRun} {}\ + Pump1 Cld 0 1 1 1 0 text user {} {} {CLD} {wrCld} {}\ + Pump1 Out 0 1 1 1 0 text user {} {} {OUT} {wrOut} {}\ + Pump1 Rat 1 1 1 1 0 text user {RAT} {rdRat} {RAT} {wrRat} {}\ + Pump1 Vol 1 1 1 1 0 text user {VOL} {rdVol} {VOL} {wrVol} {}\ + Pump1 Dir 1 1 1 1 0 text user {DIR} {rdDir} {DIR} {wrDir} {}\ + Pump1 Buz 1 1 1 1 0 text user {BUZ} {rdBuz} {BUZ} {wrBuz} {}\ + Pump1 Dis 1 0 1 1 0 text internal {DIS} {rdDis} {} {} {}\ + Pump1 In2 1 0 1 1 0 text internal {IN2} {rdInp} {} {} {}\ + Pump1 In3 1 0 1 1 0 text internal {IN3} {rdInp} {} {} {}\ + Pump1 In4 1 0 1 1 0 text internal {IN4} {rdInp} {} {} {}\ + Pump1 In6 1 0 1 1 0 text internal {IN6} {rdInp} {} {} {}\ + Pump1 Ver 1 0 1 1 0 text internal {VER} {rdVer} {} {} {}\ + } + + hfactory $scobj_hpath/Pump0 plain spy none + hfactory $scobj_hpath/Pump1 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 $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 +} + +puts stdout "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