- Testing generic controllers...
This commit is contained in:
koennecke
@ -1,3 +1,3 @@
|
|||||||
91
|
99
|
||||||
NEVER, EVER modify or delete this file
|
NEVER, EVER modify or delete this file
|
||||||
You'll risk eternal damnation and a reincarnation as a cockroach!|n
|
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
|
# 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\
|
# 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
|
# 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
|
# 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.
|
# The UDP port where the server will wait for Interrupts from clients.
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
# Obviously, clients wishing to interrupt need to know this number.
|
||||||
|
|
||||||
@ -197,4 +197,271 @@ hattach /instrument lotte title
|
|||||||
|
|
||||||
restore
|
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