Create fake DMC2280 controllers.

r1138 | ffr | 2006-10-13 09:06:05 +1000 (Fri, 13 Oct 2006) | 2 lines

site_ansto/instrument/TEST_SICS/fakeDMC/dmc2280Server.tcl

@@ -0,0 +1,66 @@
+# $Revision: 1.1 $
+# $Date: 2006-10-12 23:06:05 $
+# 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"
+
+        switch -glob $line {
+          "" {puts -nonewline $channel ":"}
+          "kill" {exit}
+          "SH*" - "BG*" - "PA*" - "DP*" - "AT*" - "MO*" - "ST*" - "SP*" - "AC*" - "DC*" {
+            eval [parse $line]
+            puts -nonewline $channel ":"
+          }
+          "TP*" - "TD*" {
+            set output [eval [parse $line]]
+            puts $channel " $output"; puts -nonewline $channel ":"
+          }
+          "TS*" {
+            set output [eval [parse $line]]
+            puts $channel " $output"; puts -nonewline $channel ":"
+          }
+          "TC 1" {
+            puts $channel " DMC2280 ERROR"; puts -nonewline $channel ":"
+          }
+          "MG _*" {
+            set output [eval [parse $line]]
+            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;
+}