From b60f7f25f38d9386510c4e1abc7a44cbd4d23c6b Mon Sep 17 00:00:00 2001 From: koennecke Date: Tue, 27 Nov 2007 13:39:10 +0000 Subject: [PATCH] - Testing generic controllers... --- test/DataNumber | 2 +- test/testini.tcl | 273 ++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 271 insertions(+), 4 deletions(-) diff --git a/test/DataNumber b/test/DataNumber index b380fc4e..7f22e2d7 100644 --- a/test/DataNumber +++ b/test/DataNumber @@ -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 \ No newline at end of file diff --git a/test/testini.tcl b/test/testini.tcl index 51fc4254..210d6ba4 100644 --- a/test/testini.tcl +++ b/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 + +