# $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;
}