130 lines
3.6 KiB
Tcl
130 lines
3.6 KiB
Tcl
# $Revision: 1.1.2.3 $
|
|
# $Date: 2010-05-14 02:36:39 $
|
|
# 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 readLine {channel} {
|
|
global ADDRESS
|
|
global CURRENT
|
|
global FREQUENCY
|
|
global VOLTAGE
|
|
global bSWITCHES
|
|
global bOPSTATE
|
|
set TESTMODE "normal"
|
|
|
|
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"
|
|
puts -nonewline $channel $CURRENT
|
|
puts stdout "SENT current = $CURRENT"
|
|
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"
|
|
if {$TESTMODE == "normal"} {
|
|
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 65001
|