#!/usr//bin/env tclsh
# $Revision: 1.1.2.5 $
# $Date: 2010-05-20 00:51:15 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $

# Run with tclsh SIM_RFGen.tcl
# Creates a socket server which listens for connections and accepts commands
# from clients (eg SICS).
proc serverOpen {channel addr port} {
  global voltage
  global connected
  set connected 1
  set voltage 0
  fconfigure $channel -translation binary -buffering none
  fileevent $channel readable "readLine $channel"
  puts "OPENED"
  return;
}

set VOLTAGE [format "%02d" 50]
set CURRENT [format "%02d" 0]
set FREQUENCY [format "%03d" 170]
set bSWITCHES [binary format B8 10001111]
set bOPSTATE  [binary format B8 10000101]

proc trimzpad {a} {
 if {$a == 0} {
  return "0"
 } else {
  return [string trimleft $a 0]
 }
}
proc readLine {channel} {
  global ADDRESS
  global CURRENT
  global FREQUENCY
  global VOLTAGE
  global bSWITCHES
  global bOPSTATE
  set TESTMODE "realistic"

  set data [read $channel 1]
  binary scan $data c sigStart
  puts stdout "RECEIVED: start byte=$sigStart"
  if {$sigStart != 2} {
    puts stderr "ERROR: start byte should be 2 not $sigStart"
    flush stdout
    flush stderr
    flush $channel
    return
  }
  set ADDRESS [read $channel 1]
  puts "RECEIVED: address = $ADDRESS"
  set cmdType [read $channel 1]
  puts "RECEIVED: command type = $cmdType"
  switch $cmdType {
    "L" {
      set data [read $channel 1]
      binary scan $data c sigEnd
      if {$sigEnd != 3} {
        puts stderr "ERROR: end byte should be 3 not $sigEnd"
        flush stdout
        flush stderr
        flush $channel
        return
      }
      puts stdout "RECEIVED: end byte=$sigEnd"
      puts -nonewline $channel [binary format c 0x02]
      puts stdout "SENT start byte 2"
      puts -nonewline $channel $ADDRESS
      puts stdout "SENT address = $ADDRESS"
      puts -nonewline $channel "L"
      puts stdout "SENT command type = L"
      switch $TESTMODE {
        "reliable" {
          # Just report what we receive for the current
          set currOut $CURRENT
        }
        "realistic" {
          set curr [trimzpad $CURRENT]
          set curr [ expr { $curr-1 + round(rand()) } ]
          set currOut [format "%02d" $curr]
        }
        "locurr" {
          set curr [trimzpad $CURRENT]
          set curr [ expr { $curr-1 } ]
          set currOut [format "%02d" $curr]
        }
      }
      puts -nonewline $channel $currOut
      puts stdout "SENT current = $currOut"
      puts -nonewline $channel $FREQUENCY
      puts stdout "SENT frequency = $FREQUENCY"
      puts -nonewline $channel $VOLTAGE
      puts stdout "SENT voltage = $VOLTAGE"
      binary scan $bSWITCHES B8 SW
      set SW [string replace $SW 0 0 1]
      set bSWITCHES [binary format B8 $SW]
      puts -nonewline $channel $bSWITCHES
      puts stdout "SENT switches $SW"
      puts -nonewline $channel $bOPSTATE
      binary scan $bOPSTATE B8 OS
      puts stdout "SENT opstate $OS"
      puts -nonewline $channel [binary format c 0x03]
      puts stdout "SENT end byte 3"
    }
    "S" {
      set currIn [read $channel 2]
      puts stdout "RECEIVED: current = $CURRENT"
      set freqIn [read $channel 3]
      puts stdout "RECEIVED: frequency = $FREQUENCY"
      set swIn [read $channel 1]
      binary scan $swIn B8 SW
      puts stdout "RECEIVED: switches = $SW"
      set CURRENT $currIn
      set FREQUENCY $freqIn
      set bSWITCHES $swIn
      set data [read $channel 1]
      binary scan $data c sigEnd
      if {$sigEnd != 3} {
        puts stderr "ERROR: end byte should be 3 not $sigEnd"
        flush stdout
        flush stderr
        flush $channel
        return
      }
      puts stdout "RECEIVED: end byte=$sigEnd"
    }
    default {
      puts stderr "ERROR: Unknown command type $cmdType, should be 'L' or 'S'"
    }
  }
  flush stdout
  flush stderr
  flush $channel
  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;
}

startserver -port 64001