- Testing generic controllers...
This commit is contained in:
koennecke
@ -1,3 +1,3 @@
|
||||
91
|
||||
99
|
||||
NEVER, EVER modify or delete this file
|
||||
You'll risk eternal damnation and a reincarnation as a cockroach!|n
|
||||
273
test/testini.tcl
273
test/testini.tcl
@ -22,11 +22,11 @@ ServerOption ReadUserPasswdTimeout 500000
|
||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
||||
# if there is a problem connecting to a server due to network overload\
|
||||
|
||||
ServerOption ServerPort 5511
|
||||
ServerOption ServerPort 2911
|
||||
# the port number the server is going to listen at. The client MUST know
|
||||
# this number in order to connect. It is in client.ini
|
||||
|
||||
ServerOption InterruptPort 5513
|
||||
ServerOption InterruptPort 2913
|
||||
# The UDP port where the server will wait for Interrupts from clients.
|
||||
# Obviously, clients wishing to interrupt need to know this number.
|
||||
|
||||
@ -197,4 +197,271 @@ hattach /instrument lotte title
|
||||
|
||||
restore
|
||||
|
||||
evfactory new heini psi-dsp lnsts10 3016
|
||||
|
||||
# Generic Controller
|
||||
#-------------------------------------------------------------------
|
||||
MakeAsyncProtocol norma
|
||||
MakeAsyncQueue farmQueue norma localhost 9090
|
||||
MakeGenController farm
|
||||
genconfigure asynconnect farm farmQueue
|
||||
#------------------------------------------------
|
||||
proc farmFormat {par num} {
|
||||
hsetprop /sics/farm/$par lastError none
|
||||
return [format "$par %d" [string trim $num]]
|
||||
}
|
||||
#-----------------------------------------------
|
||||
proc farmRead {par } {
|
||||
hsetprop /sics/farm/$par lastError none
|
||||
hsetprop /sics/farm/$par replyCommand "farmReply $par"
|
||||
return $par
|
||||
}
|
||||
#-----------------------------------------------
|
||||
proc farmReply {par reply} {
|
||||
set action [string trim [hgetpropval /sics/farm/$par status]]
|
||||
hsetprop /sics/farm/$par status idle
|
||||
if {[string first OK $reply] >= 0} {
|
||||
if {[string first get $action] >= 0} {
|
||||
set idx [string first : $reply]
|
||||
if {$idx > 0} {
|
||||
set val [string trim [string range $reply [expr $idx +1] end]]
|
||||
hupdate /sics/farm/$par $val
|
||||
}
|
||||
} else {
|
||||
hget /sics/farm/$par
|
||||
}
|
||||
} else {
|
||||
if {[string first ERROR $reply] < 0} {
|
||||
set reply "ERROR: $reply"
|
||||
}
|
||||
clientPut $reply
|
||||
error $reply
|
||||
}
|
||||
}
|
||||
#=============================================
|
||||
proc schconset {val} {
|
||||
set com [farmFormat schnegge $val]
|
||||
hsetprop /sics/farm/schneggecon replyCommand schreply
|
||||
return $com
|
||||
}
|
||||
#----------------------------------------------
|
||||
proc schreply {reply} {
|
||||
clientput "schreply $reply"
|
||||
if {[string first OK $reply] >= 0} {
|
||||
hsetprop /sics/farm/schneggerunning readCommand schrunget
|
||||
hget /sics/farm/schneggerunning
|
||||
hsetprop /sics/farm/schneggerunning readCommand \
|
||||
"farmReply schneggerunning"
|
||||
} else {
|
||||
hsetprop /sics/farm/schneggecon status idle
|
||||
hsetprop /sics/farm/schneggecon lastError $reply
|
||||
clientput "ERROR: $reply on schnegge"
|
||||
}
|
||||
}
|
||||
#-----------------------------------------------
|
||||
proc schrun {reply} {
|
||||
clientput "schrun $reply"
|
||||
hsetprop /sics/farm/schneggerunning status idle
|
||||
if {[string first OK $reply] >= 0} {
|
||||
set idx [string first : $reply]
|
||||
if {$idx > 0} {
|
||||
set val [string trim [string range $reply [expr $idx +1] end]]
|
||||
hupdate /sics/farm/schneggerunning $val
|
||||
if {$val == 1} {
|
||||
clientput "schnegge creeping"
|
||||
hsetprop /sics/farm/schneggerunning readCommand schrunget
|
||||
hget /sics/farm/schneggerunning
|
||||
hsetprop /sics/farm/schneggerunning readCommand \
|
||||
"farmReply schneggerunning"
|
||||
} else {
|
||||
clientput "schnegge finished"
|
||||
hsetprop /sics/farm/schneggerunning readCommand \
|
||||
"farmRead schneggerunning"
|
||||
hsetprop /sics/farm/schneggecon status idle
|
||||
}
|
||||
}
|
||||
} else {
|
||||
clientput "schnegge has error: $reply"
|
||||
hsetprop /sics/farm/schneggerunning readCommand \
|
||||
"farmRead schneggerunning"
|
||||
hsetprop /sics/farm/schneggecon status idle
|
||||
hsetprop /sics/farm/schneggecon lastError $reply
|
||||
hsetprop /sics/farm/schneggerunning lastError $reply
|
||||
}
|
||||
}
|
||||
#----------------------------------------------
|
||||
proc schget {} {
|
||||
hsetprop /sics/farm/schneggecon lastError none
|
||||
hsetprop /sics/farm/schneggecon replyCommand "farmReply schneggecon"
|
||||
return schnegge
|
||||
}
|
||||
#----------------------------------------------
|
||||
proc schrunget {} {
|
||||
hsetprop /sics/farm/schneggerunning lastError none
|
||||
hsetprop /sics/farm/schneggerunning replyCommand schrun
|
||||
return schneggerunning
|
||||
}
|
||||
#-----------------------------------------------
|
||||
set farm 0
|
||||
if {$farm == 1} {
|
||||
genconfigure makepar farm hase int
|
||||
hsetprop /sics/farm/hase priv user
|
||||
hsetprop /sics/farm/hase writeCommand "farmFormat hase"
|
||||
hsetprop /sics/farm/hase readCommand "farmRead hase"
|
||||
hsetprop /sics/farm/hase replyCommand "farmReply hase"
|
||||
|
||||
genconfigure makepar farm schnegge int
|
||||
hsetprop /sics/farm/schnegge priv user
|
||||
hsetprop /sics/farm/schnegge writeCommand "farmFormat schnegge"
|
||||
hsetprop /sics/farm/schnegge readCommand "farmRead schnegge"
|
||||
hsetprop /sics/farm/schnegge replyCommand "farmReply schnegge"
|
||||
|
||||
genconfigure makepar farm schneggerunning int
|
||||
hsetprop /sics/farm/schneggerunning priv internal
|
||||
hsetprop /sics/farm/schneggerunning readCommand "farmRead schneggerunning"
|
||||
hsetprop /sics/farm/schneggerunning replyCommand "farmReply schneggerunning"
|
||||
|
||||
genconfigure makepar farm schneggecon int
|
||||
hsetprop /sics/farm/schneggecon priv user
|
||||
hsetprop /sics/farm/schneggecon writeCommand schconset
|
||||
hsetprop /sics/farm/schneggecon readCommand schget
|
||||
hsetprop /sics/farm/schneggecon replyCommand schreply
|
||||
}
|
||||
# Generic Controller
|
||||
#-------------------------------------------------------------------
|
||||
MakeAsyncProtocol norma
|
||||
MakeAsyncQueue farmQueue norma localhost 9090
|
||||
MakeGenController farm
|
||||
genconfigure asynconnect farm farmQueue
|
||||
#------------------------------------------------
|
||||
proc farmFormat {par num} {
|
||||
hsetprop /sics/farm/$par lastError none
|
||||
return [format "$par %d" [string trim $num]]
|
||||
}
|
||||
#-----------------------------------------------
|
||||
proc farmRead {par } {
|
||||
hsetprop /sics/farm/$par lastError none
|
||||
hsetprop /sics/farm/$par replyCommand "farmReply $par"
|
||||
return $par
|
||||
}
|
||||
#-----------------------------------------------
|
||||
proc farmReply {par reply} {
|
||||
set action [string trim [hgetpropval /sics/farm/$par status]]
|
||||
hsetprop /sics/farm/$par status idle
|
||||
if {[string first OK $reply] >= 0} {
|
||||
if {[string first get $action] >= 0} {
|
||||
set idx [string first : $reply]
|
||||
if {$idx > 0} {
|
||||
set val [string trim [string range $reply [expr $idx +1] end]]
|
||||
hupdate /sics/farm/$par $val
|
||||
}
|
||||
} else {
|
||||
hget /sics/farm/$par
|
||||
}
|
||||
} else {
|
||||
if {[string first ERROR $reply] < 0} {
|
||||
set reply "ERROR: $reply"
|
||||
}
|
||||
clientPut $reply
|
||||
error $reply
|
||||
}
|
||||
}
|
||||
#=============================================
|
||||
proc schconset {val} {
|
||||
set com [farmFormat schnegge $val]
|
||||
hsetprop /sics/farm/schneggecon replyCommand schreply
|
||||
return $com
|
||||
}
|
||||
#----------------------------------------------
|
||||
proc schreply {reply} {
|
||||
clientput "schreply $reply"
|
||||
if {[string first OK $reply] >= 0} {
|
||||
hsetprop /sics/farm/schneggerunning readCommand schrunget
|
||||
hget /sics/farm/schneggerunning
|
||||
hsetprop /sics/farm/schneggerunning readCommand \
|
||||
"farmReply schneggerunning"
|
||||
} else {
|
||||
hsetprop /sics/farm/schneggecon status idle
|
||||
hsetprop /sics/farm/schneggecon lastError $reply
|
||||
clientput "ERROR: $reply on schnegge"
|
||||
}
|
||||
}
|
||||
#-----------------------------------------------
|
||||
proc schrun {reply} {
|
||||
clientput "schrun $reply"
|
||||
hsetprop /sics/farm/schneggerunning status idle
|
||||
if {[string first OK $reply] >= 0} {
|
||||
set idx [string first : $reply]
|
||||
if {$idx > 0} {
|
||||
set val [string trim [string range $reply [expr $idx +1] end]]
|
||||
hupdate /sics/farm/schneggerunning $val
|
||||
if {$val == 1} {
|
||||
clientput "schnegge creeping"
|
||||
hsetprop /sics/farm/schneggerunning readCommand schrunget
|
||||
hget /sics/farm/schneggerunning
|
||||
hsetprop /sics/farm/schneggerunning readCommand \
|
||||
"farmReply schneggerunning"
|
||||
} else {
|
||||
clientput "schnegge finished"
|
||||
hsetprop /sics/farm/schneggerunning readCommand \
|
||||
"farmRead schneggerunning"
|
||||
hsetprop /sics/farm/schneggecon status idle
|
||||
}
|
||||
}
|
||||
} else {
|
||||
clientput "schnegge has error: $reply"
|
||||
hsetprop /sics/farm/schneggerunning readCommand \
|
||||
"farmRead schneggerunning"
|
||||
hsetprop /sics/farm/schneggecon status idle
|
||||
hsetprop /sics/farm/schneggecon lastError $reply
|
||||
hsetprop /sics/farm/schneggerunning lastError $reply
|
||||
}
|
||||
}
|
||||
#----------------------------------------------
|
||||
proc schget {} {
|
||||
hsetprop /sics/farm/schneggecon lastError none
|
||||
hsetprop /sics/farm/schneggecon replyCommand "farmReply schneggecon"
|
||||
return schnegge
|
||||
}
|
||||
#----------------------------------------------
|
||||
proc schrunget {} {
|
||||
hsetprop /sics/farm/schneggerunning lastError none
|
||||
hsetprop /sics/farm/schneggerunning replyCommand schrun
|
||||
return schneggerunning
|
||||
}
|
||||
#-----------------------------------------------
|
||||
set farm 0
|
||||
if {$farm == 1} {
|
||||
genconfigure makepar farm hase int
|
||||
hsetprop /sics/farm/hase priv user
|
||||
hsetprop /sics/farm/hase writeCommand "farmFormat hase"
|
||||
hsetprop /sics/farm/hase readCommand "farmRead hase"
|
||||
hsetprop /sics/farm/hase replyCommand "farmReply hase"
|
||||
|
||||
genconfigure makepar farm schnegge int
|
||||
hsetprop /sics/farm/schnegge priv user
|
||||
hsetprop /sics/farm/schnegge writeCommand "farmFormat schnegge"
|
||||
hsetprop /sics/farm/schnegge readCommand "farmRead schnegge"
|
||||
hsetprop /sics/farm/schnegge replyCommand "farmReply schnegge"
|
||||
|
||||
genconfigure makepar farm schneggerunning int
|
||||
hsetprop /sics/farm/schneggerunning priv internal
|
||||
hsetprop /sics/farm/schneggerunning readCommand "farmRead schneggerunning"
|
||||
hsetprop /sics/farm/schneggerunning replyCommand "farmReply schneggerunning"
|
||||
|
||||
genconfigure makepar farm schneggecon int
|
||||
hsetprop /sics/farm/schneggecon priv user
|
||||
hsetprop /sics/farm/schneggecon writeCommand schconset
|
||||
hsetprop /sics/farm/schneggecon readCommand schget
|
||||
hsetprop /sics/farm/schneggecon replyCommand schreply
|
||||
}
|
||||
|
||||
source sansdruck.tcl
|
||||
|
||||
|
||||
#MakeRS232Controller sadu pc4639 4168
|
||||
#MakeRS232Controller sadu localhost 4168
|
||||
#sadu replyterminator 0x04
|
||||
#sadu sendterminator 0x04
|
||||
#sadu timeout 1000
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user