b134c901c5
hipd/config/commands/commands.tcl Added some of the procedures in extraconfig.tcl as "commands" motors/sct_jogmotor_common.tcl Added stop command. Send SH, JG and BG commands on one line when jogging motor. fakeDMC dmc2280Server.tcl mkSimAxes.tcl simAxis.tcl Added jog command. exebuf.c Batch file executor now sends a BATCHEND event when there is an AbortBatch interrupt. This means we can now execute cleanup comands when a batch file terminates. r2764 | ffr | 2009-01-23 16:06:03 +1100 (Fri, 23 Jan 2009) | 17 lines
73 lines
2.2 KiB
Tcl
73 lines
2.2 KiB
Tcl
# $Revision: 1.4 $
|
|
# $Date: 2009-01-23 05:06:03 $
|
|
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
|
# Last revision by: $Author: ffr $
|
|
|
|
# Creates a socket server which listens for connections and accepts commands
|
|
# from DMC2280 clients (eg SICS).
|
|
proc serverOpen {channel addr port} {
|
|
global connected
|
|
set connected 1
|
|
fileevent $channel readable "readLine Server $channel"
|
|
puts "OPENED"
|
|
return;
|
|
}
|
|
|
|
# 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
|
|
if {[gets $channel line]<0} {
|
|
fileevent $channel readable {}
|
|
after idle "close $channel;set out 1"
|
|
} else {
|
|
puts "RECEIVED: $line"
|
|
|
|
foreach cmd [split $line ";"] {
|
|
switch -glob $cmd {
|
|
"" {puts -nonewline $channel ":"}
|
|
"kill" {exit}
|
|
"SH*" - "BG*" - "PA*" - "PR*" - "JG*" - "DP*" - "AT*" - "MO*" - "ST*" - "SP*" - "AC*" - "DC*" {
|
|
eval [parse $cmd]
|
|
puts -nonewline $channel ":"
|
|
}
|
|
"TP*" - "TD*" - "TI*" - "XQ*" {
|
|
set output [eval [parse $cmd]]
|
|
puts $channel " $output"; puts -nonewline $channel ":"
|
|
}
|
|
"LV" {
|
|
set output [eval [parse $cmd]]
|
|
puts $channel "$output"; puts -nonewline $channel ":"
|
|
}
|
|
"TS*" {
|
|
set output [eval [parse $cmd]]
|
|
puts $channel " $output"; puts -nonewline $channel ":"
|
|
}
|
|
"TC 1" {
|
|
puts $channel " DMC2280 ERROR"; puts -nonewline $channel ":"
|
|
}
|
|
"MG *" {
|
|
set output [eval [parse $cmd]]
|
|
puts $channel " $output"; puts -nonewline $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)];
|
|
after 100 update;
|
|
if {$tcl_interactive==0} {vwait forever }
|
|
return;
|
|
}
|