Initial revision
This commit is contained in:
cvs
273
hakle.tcl
Normal file
273
hakle.tcl
Normal file
@@ -0,0 +1,273 @@
|
||||
#----------------------------------------------------------------------------
|
||||
# H A K L E
|
||||
#
|
||||
# Driver for the Haake water bath thermostat in the SINQ setup. This driver
|
||||
# is realised in Tcl and uses the tclev interface for talking to SICS.
|
||||
#
|
||||
# copyright: see copyright.h
|
||||
#
|
||||
# Mark Koennecke, February 1998
|
||||
#----------------------------------------------------------------------------
|
||||
set HakleNUM 0
|
||||
|
||||
proc HakleSend args {
|
||||
upvar #0 [lindex $args 0] ar
|
||||
set command [lrange $args 1 end]
|
||||
set ret [catch {$ar(socket) $command} msg]
|
||||
if {$ret != 0} {
|
||||
ClientPut $msg
|
||||
error -701
|
||||
}
|
||||
return $msg
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# HakleCheck tests a answer from the Hake for validity. Valid answers
|
||||
# contain a $. Errors no $ and and F as first character.
|
||||
proc HakleCheck {text } {
|
||||
if { [string match *\$ $text]} {
|
||||
return 1
|
||||
}
|
||||
if { [string match F* $text] } {
|
||||
error -703
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
proc HakleCommand args {
|
||||
upvar #0 [lindex $args 0] ar
|
||||
set ret [catch {eval HakleSend $args} msg]
|
||||
if {$ret != 0} {
|
||||
error $msg
|
||||
}
|
||||
set ret [catch {HakleCheck $msg} msg2]
|
||||
if {$ret != 0} {
|
||||
error $msg2
|
||||
}
|
||||
return $msg
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
proc HakleInit {Hakle} {
|
||||
upvar $Hakle ar
|
||||
global HakleNUM
|
||||
#------ open a connection
|
||||
set nam hakle$HakleNUM
|
||||
set ret [catch {serialport $nam $ar(computer) $ar(port) \
|
||||
$ar(channel) 1} msg]
|
||||
if {$ret != 0 } {
|
||||
ClientPut $msg
|
||||
error -700
|
||||
}
|
||||
set ar(socket) $nam
|
||||
incr HakleNUM
|
||||
set ar(intern) 1
|
||||
set ar(pending) 0
|
||||
set ar(lastread) 20.00
|
||||
#----- configure
|
||||
$nam -replyterm "1\r"
|
||||
$nam -tmo 1800
|
||||
#----- block local
|
||||
set ret [catch {HakleCommand $Hakle OUT MODE 3 0} msg ]
|
||||
if {$ret != 0 } {
|
||||
error -$msg
|
||||
}
|
||||
return 1
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
proc HakleClose {Hakle} {
|
||||
upvar #0 $Hakle ar
|
||||
set ret [catch {HakleCommand $Hakle OUT MODE 3 1} msg]
|
||||
if {$ret != 0} {
|
||||
ClientPut "Error resettting Haake Thermostat"
|
||||
}
|
||||
rename $ar(socket) ""
|
||||
return 1
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
proc HakleWrapper args {
|
||||
upvar #0 [lindex $args 0] ar
|
||||
if { [llength $args] < 2 } {
|
||||
error "Insufficient number of commands"
|
||||
}
|
||||
set key [lindex $args 1]
|
||||
switch -exact $key {
|
||||
sensor {
|
||||
if { [llength $args] > 2 } {
|
||||
set val [lindex $args 2]
|
||||
#------- switch to intern
|
||||
if { [string compare $val intern] == 0 } {
|
||||
set ret [catch {HakleCommand [lindex $args 0] OUT MODE 2 0} msg]
|
||||
if {$ret != 0 } {
|
||||
error $msg
|
||||
} else {
|
||||
set ar(intern) 1
|
||||
}
|
||||
#-------- switch to extern
|
||||
} elseif { [string compare $val extern] == 0 } {
|
||||
set ret [catch {HakleCommand [lindex $args 0] OUT MODE 2 1} msg]
|
||||
if {$ret != 0 } {
|
||||
error $msg
|
||||
} else {
|
||||
set ar(intern) 0
|
||||
}
|
||||
} else {
|
||||
error -705
|
||||
}
|
||||
} else {
|
||||
if { $ar(intern) == 1 } {
|
||||
ClientPut [format "%s.sensor intern" $ar(MyName)]
|
||||
return 1
|
||||
} else {
|
||||
ClientPut [format "%s.sensor extern" $ar(MyName)]
|
||||
return 1
|
||||
}
|
||||
}
|
||||
}
|
||||
list {
|
||||
if { $ar(intern) == 1 } {
|
||||
ClientPut [format "%s.sensor intern" $ar(MyName)]
|
||||
error -700
|
||||
} else {
|
||||
ClientPut [format "%s.sensor extern" $ar(MyName)]
|
||||
error -700
|
||||
}
|
||||
|
||||
}
|
||||
default {
|
||||
error -700
|
||||
}
|
||||
}
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
proc HakleSet {Hakle val} {
|
||||
upvar #0 $Hakle ar
|
||||
# ClientPut "HakleSet"
|
||||
set ret [catch {$ar(socket) [format "OUT SP 1 %f" $val]} msg]
|
||||
if {$ret != 0} {
|
||||
ClientPut $msg
|
||||
error -701
|
||||
}
|
||||
set ret [catch {HakleCheck $msg} msg2]
|
||||
if {$ret != 0} {
|
||||
error $msg2
|
||||
}
|
||||
set ar(pending) 0
|
||||
return $msg
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
proc HakleGet {Hakle} {
|
||||
upvar #0 $Hakle ar
|
||||
if {$ar(intern) == 1} {
|
||||
set ret [catch {eval HakleCommand $Hakle IN PV 1} msg]
|
||||
if {$ret != 0 } {
|
||||
error $msg
|
||||
}
|
||||
} else {
|
||||
set ret [catch {HakleCommand IN PV 2} msg]
|
||||
if {$ret != 0 } {
|
||||
error $msg
|
||||
}
|
||||
}
|
||||
set ans [string trim $msg \$]
|
||||
set ans2 [string trim $ans]
|
||||
set ans3 [string trim $ans2 C]
|
||||
#------ fix some pecularities of the Haake, sometimes it gives empty
|
||||
# messages or double +
|
||||
if { [string length $ans3] < 3 } {
|
||||
return $ar(lastread)
|
||||
}
|
||||
if { [string first "++" $ans3] >= 0 } {
|
||||
set ans3 [string range $ans3 1 end]
|
||||
}
|
||||
set ar(lastread) $ans3
|
||||
return $ans3
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
proc HakleGet2 {Hakle} {
|
||||
upvar #0 $Hakle ar
|
||||
# ClientPut "HakleGet"
|
||||
if {$ar(pending) == 0} {
|
||||
if {$ar(intern) == 1} {
|
||||
set ret [catch {$ar(socket) -put IN PV 1} msg]
|
||||
if {$ret != 0 } {
|
||||
ClientPut $msg
|
||||
error -701
|
||||
}
|
||||
} else {
|
||||
set ret [catch {$ar(socket) -put IN PV 2} msg]
|
||||
if {$ret != 0 } {
|
||||
ClientPut $msg
|
||||
error -701
|
||||
}
|
||||
}
|
||||
set ar(pending) 1
|
||||
return $ar(lastread)
|
||||
} else {
|
||||
if {[$ar(socket) -readable] == 1 } {
|
||||
set ar(pending) 0
|
||||
set ret [catch {$ar(socket) -get} msg]
|
||||
if {$ret != 0 } {
|
||||
ClientPut $msg
|
||||
error -701
|
||||
}
|
||||
set ans [string trim $msg \$]
|
||||
set ans2 [string trim $ans]
|
||||
set ans3 [string trim $ans2 C]
|
||||
set ar(lastread) $ans3
|
||||
return $ans3
|
||||
} else {
|
||||
return $ar(lastread)
|
||||
}
|
||||
}
|
||||
}
|
||||
#-----------------------------------------------------------------------------
|
||||
proc HakleError {Hakle val} {
|
||||
upvar #0 $Hakle ar
|
||||
switch -exact -- $val {
|
||||
-700 {
|
||||
return "Cannot open socket"
|
||||
}
|
||||
-701 {
|
||||
return "Error sending command"
|
||||
}
|
||||
-703 {
|
||||
return "Invalid command sent"
|
||||
}
|
||||
default {
|
||||
return "Unknown error code"
|
||||
}
|
||||
}
|
||||
}
|
||||
#-----------------------------------------------------------------------------
|
||||
proc HakleFix {Hakle val} {
|
||||
upvar #0 $Hakle ar
|
||||
switch -exact -- $val {
|
||||
-700 {
|
||||
return DEVFAIL
|
||||
}
|
||||
-701 {
|
||||
return DEVREDO
|
||||
}
|
||||
-703 {
|
||||
return DEVREDO
|
||||
}
|
||||
default {
|
||||
return DEVFAIL
|
||||
}
|
||||
}
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
proc inihaakearray {ar comp port chan} {
|
||||
upvar #0 $ar Hakle
|
||||
set Hakle(Init) HakleInit
|
||||
set Hakle(Close) HakleClose
|
||||
set Hakle(Send) HakleSend
|
||||
set Hakle(SetValue) HakleSet
|
||||
set Hakle(GetValue) HakleGet
|
||||
set Hakle(GetError) HakleError
|
||||
set Hakle(TryFixIt) HakleFix
|
||||
set Hakle(Wrapper) HakleWrapper
|
||||
set Hakle(computer) $comp
|
||||
set Hakle(port) $port
|
||||
set Hakle(channel) $chan
|
||||
set Hakle(num) 0
|
||||
set Hakle(lastread) 20.00
|
||||
}
|
||||
Reference in New Issue
Block a user