Added fake disk chopper controller.

This commit is contained in:
Ferdi Franceschini
2013-04-23 14:32:24 +10:00
parent 2ea0e042ee
commit e28ef59bd0
2 changed files with 228 additions and 1 deletions

View File

@@ -0,0 +1,227 @@
# $Revision: 1.2 $
# $Date: 2007/03/16 06:11:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
# Creates a socket server which listens for connections and accepts commands
proc serverOpen {channel addr port} {
global connected
global serverState
set serverState "UID"
set connected 1
fileevent $channel readable "readLine Server $channel"
puts "OPENED"
puts -nonewline $channel "#SES#Fill in your user ID"
flush $channel
return
}
proc reset {} {
global serverState
set serverState "UID"
}
proc getUID {channel line} {
global validUID
global validPWD
global serverState
puts "Get UID"
switch -glob $line {
"kill" {exit}
"user:*" {
if {$line == "user:NCS"} {
puts "validUID"
set validUID true
} else {
puts "invalidUID"
set validUID false
}
puts "send fill in password msg"
puts -nonewline $channel "#SES#Fill in your password"
}
default {
puts "invalidUID"
set validUID false
puts -nonewline $channel "#SES#Fill in your password"
}
}
set serverState "PWD"
}
proc getPWD {channel line} {
global validUID
global validPWD
global serverState
puts "Get PWD"
switch -glob $line {
"kill" {exit}
"password:NCS013" {
if {$line == "password:NCS013"} {
puts "validPWD"
set validPWD true
} else {
puts "invalidPWD"
set validPWD false
}
if {$validUID && $validPWD} {
puts -nonewline $channel "#SES#Hello"
set serverState "CMD"
} else {
puts -nonewline $channel "#SES#You are not a valid user, try again!"
puts -nonewline $channel "#SES#Fill in your user ID"
set serverState "UID"
}
}
default {
puts "invalidPWD"
set validPWD false
puts -nonewline $channel "#SES#You are not a valid user, try again!"
puts -nonewline $channel "#SES#Fill in your user ID"
set serverState "UID"
}
}
}
proc getCMD {channel line} {
global validUID
global validPWD
global serverState
puts "Get CMD"
set cmd [lindex [split $line "#"] 2]
switch -glob $line {
"" {}
"kill" {exit}
"#SOS#STATE 1:" {
puts -nonewline $channel "#SOS#ACCEPT CH= 1# State= Synchron.#ASPEED= 0#RSPEED= 0#APHASE= -0.72#RPHASE= 0#AVETO = 0#DIR = CW#MONIT = ok#FLOWR = 3.7#WTEMP = 14.2#MTEMP = 18.1#MVIBR = 0.0#MVACU = 0.0022#DATE = 9/10/2007#TIME = 4:48:36 PM#"
}
"#SOS#STATE 2:" {
puts -nonewline $channel "#SOS#ACCEPT CH= 2# State= Synchron.#ASPEED= 0#RSPEED= 0#APHASE= -0.72#RPHASE= -0.6#AVETO = 0#DIR = CW#MONIT = ok#FLOWR = 3.7#WTEMP = 14.2#MTEMP = 18.1#MVIBR = 0.0#MVACU = 0.0022#DATE = 9/10/2007#TIME = 4:48:36 PM#"
}
"#SOS#STATE 3:" {
puts -nonewline $channel "#SOS#ACCEPT CH= 3# State= Synchron.#ASPEED= 0#RSPEED= 0#APHASE= 999.99#RPHASE= -0.6#AVETO = 0#DIR = CW#MONIT = ok#FLOWR = 3.7#WTEMP = 14.2#MTEMP = 18.1#MVIBR = 0.0#MVACU = 0.0022#DATE = 9/10/2007#TIME = 4:48:36 PM#"
}
"#SOS#STATE 4:" {
puts -nonewline $channel "#SOS#ACCEPT CH= 4# State= Synchron.#ASPEED= 0#RSPEED= 0#APHASE= -0.72#RPHASE= -0.6#AVETO = 0#DIR = CW#MONIT = ok#FLOWR = 3.7#WTEMP = 14.2#MTEMP = 18.1#MVIBR = 0.0#MVACU = 0.0022#DATE = 9/10/2007#TIME = 4:48:36 PM#"
}
"#SOS#SPEED ?:*" {
set cmdarg [lindex [split $line :] 1]
if {[string length $cmdarg] != 6} {
puts "ERROR: Command must have six characters"
puts -nonewline $channel "#SOS#NCCEPT $cmd"
} elseif { [string is double $cmdarg] } {
puts -nonewline $channel "#SOS#ACCEPT $cmd"
} else {
puts "ERROR: Speed must be numeric in <$line>"
puts -nonewline $channel "#SOS#NCCEPT $cmd"
}
}
"#SOS#GEAR ?:*" {
set cmdarg [lindex [split $line :] 1]
if {[string length $cmdarg] != 6} {
puts "ERROR: Command must have six characters"
puts -nonewline $channel "#SOS#NCCEPT $cmd"
} elseif { [string is double $cmdarg] } {
puts -nonewline $channel "#SOS#ACCEPT $cmd"
} else {
puts "ERROR: Gear must be an integer in <$line>"
puts -nonewline $channel "#SOS#NCCEPT $cmd"
}
}
"#SOS#PHASE ?:*" {
set cmdarg [lindex [split $line :] 1]
if {[string length $cmdarg] != 6} {
puts "ERROR: Command must have six characters"
puts -nonewline $channel "#SOS#NCCEPT $cmd"
} elseif { [string is double $cmdarg] } {
puts -nonewline $channel "#SOS#ACCEPT $cmd"
} else {
puts "ERROR: PHASE must be a float in <$line>"
puts -nonewline $channel "#SOS#NCCEPT $cmd"
}
}
"#SOS#DIR ?:*" {
set cmdarg [lindex [split $line :] 1]
set trimarg [string trim $cmdarg]
if {[string length $cmdarg] != 6} {
puts "ERROR: Command must have six characters"
puts -nonewline $channel "#SOS#NCCEPT $cmd"
} elseif { $trimarg == "CW" || $trimarg == "CCW" } {
puts -nonewline $channel "#SOS#ACCEPT $cmd"
} else {
puts "ERROR: DIR must be CW or CCW in <$line>"
puts -nonewline $channel "#SOS#NCCEPT $cmd"
}
}
"#SOS#IDLE ?:*" {
puts -nonewline $channel "#SOS#ACCEPT $cmd"
}
"#SOS#RESUM ?:*" {
puts -nonewline $channel "#SOS#ACCEPT $cmd"
}
"#SOS#BRAKE ?:*" {
puts -nonewline $channel "#SOS#ACCEPT $cmd"
}
"#SOS#ESTOP" {
puts -nonewline $channel "#SOS#ACCEPT $cmd"
}
default {
puts -nonewline $channel "#SOS#NCCEPT $cmd"
}
}
}
# Reads a command from a DMC2280 client and then performs an appropriate
# action depending on whether or not the command produces output or has
# been defined.
proc readLine {who channel} {
global didRead
global B
global validUID
global validPWD
global serverState
if {[gets $channel line]<0} {
fileevent $channel readable {}
after idle "close $channel;set out 1"
} elseif {[eof $channel]} {
puts "RECEIVED EOF: $line"
close $f
return -code error "Got EOF, close channel"
} else {
puts "RECEIVED: $line"
switch $serverState {
"UID" {
getUID $channel $line
}
"PWD" {
getPWD $channel $line
}
"CMD" {
getCMD $channel $line
}
}
puts "flush channel"
flush $channel
flush $channel
set didRead 1
}
return;
}
# startserver -port 1034
proc startserver {args} {
global tcl_interactive;
array set parr $args;
set connected 0;
set server [socket -server serverOpen $parr(-port)];
fconfigure $server -blocking 0 -buffering none -translation binary -buffersize 1
after 100 update;
if {$tcl_interactive==0} {vwait forever }
return;
}
startserver -server localhost -port 60000

View File

@@ -30,7 +30,7 @@ foreach {key host port} {
# TEST CHOPPER HOST AND PORT
foreach {key host port} {
NCS013 localhost 10000
NCS013 localhost 60000
} {
dict set CHOPPER_HOSTPORT $key HOST $host
dict set CHOPPER_HOSTPORT $key PORT $port