X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=dialog.pl;h=d868ed93285e606b27e89bf2e75b46d323b4e2dd;hb=HEAD;hp=dbab70bb026ce8ed6f0a108573cdf7283411e8e4;hpb=a3bc64c0112dc4f6530a3c8d746beabb32b66816;p=vrDialog diff --git a/dialog.pl b/dialog.pl index dbab70b..d868ed9 100755 --- a/dialog.pl +++ b/dialog.pl @@ -3,17 +3,68 @@ use warnings; use strict; use Data::Dump qw(dump); +my $debug = $ENV{DEBUG} || 0; + +=for serial_port + use Device::SerialPort qw(:STAT); my $port = Device::SerialPort->new('/dev/ttyUSB0'); +die "can't open serial port" unless $port; $port->baudrate(9600); $port->databits(8); $port->parity('none'); $port->stopbits(1); $port->handshake('none'); -$port->read_char_time(1000); -$port->read_const_time(3000); +$port->read_char_time(500); +$port->read_const_time(1000); + +sub read_serial { + my $len = shift; + return $port->read( $len ); +} + +sub write_serial { + my $bytes = shift; + return $port->write( $bytes ); +} + +=cut + +# TODO: implement remote serial port +# remserial -x 2 -p 23000 -s "9600 raw" /dev/ttyUSB0 + +use IO::Socket::INET; + +my $sock = IO::Socket::INET->new( + PeerAddr => '192.168.1.148', + PeerPort => '23000', + Proto => 'tcp' +); +die "can't connect" unless $sock; + +sub read_serial { + my $len = shift; + my $buffer; + eval { + local $SIG{ALRM} = sub { die "read timeout" }; + alarm 3; + + warn "## read_serial $len" if $debug; + $sock->read( $buffer, $len ); + warn "## read $len ",as_hex($buffer) if $debug; + }; + alarm 0; + warn "ERROR: $@" if $@; + return $buffer; +} + +sub write_serial { + my $bytes = shift; + return $sock->print( $bytes ); +} + sub as_hex { my @out; @@ -32,24 +83,82 @@ sub hex2bytes { return $bytes; } -sub v { - my ($hex,$expect,$desc) = @_; - my $bytes = hex2bytes( $hex ); +sub crc { + my $data = shift; + my $crc = 0; + for my $i ( 0 .. length($data) - 2 ) { + if ( $crc & 0x80 ) { + $crc = ( $crc << 1 ) ^ 25; + } else { + $crc = $crc << 1; + } + $crc = $crc & 0xff; + my $byte = ord(substr($data,$i,1)); + $crc = $crc ^ $byte; +# warn "## ", as_hex(chr($byte)), " crc = ", $crc, " ", as_hex(chr($crc)); + } + # ignore checksum errors for FF, we will calulate them! + if ( chr($crc) ne substr($data,-1,1) && substr($data,-1,1) ne "\xFF" ) { + warn "CRC error for ",as_hex($data), " calulated ", as_hex(chr($crc)); + } + + return substr($data,0,-1) . chr($crc); +} + +sub v_bytes { + my ($bytes,$desc) = @_; warn "# $desc\n"; +retry: warn ">> ",as_hex( $bytes ); - $port->write( $bytes ); + crc( $bytes ); + write_serial( $bytes ); + + my $data = read_serial(1); + warn "<< len: ",ord($data) if $debug; - my $data = $port->read(1); - warn "<< len: ",ord($data); - $data .= $port->read(ord($data) - 1); + goto retry if ord($data) == 0; + + $data .= read_serial(ord($data) - 1); + crc($data); warn "<< ",as_hex($data); - warn "?? $expect\n" if $expect; + my $o = 2; + while ( $o < length($data) - 2 ) { + my $n = unpack('n', substr($data,$o,2)); + $n = -( 0xffff - $n ) if $n & 0x8000; + warn "## $o = ",$n, "\t",$n / 16,"\n"; + $o += 2; + } + + while ( $o < length($data) - 1 ) { + my $n = unpack('c', substr($data,$o,1)); + warn "## $o = ", $n, "\n"; + $o += 1; + } + + return $data; +} + +sub v { + my ($hex,$desc) = @_; + v_bytes( hex2bytes( $hex ), $desc ); } -#v '07 02 00 00 00 04 C4', "hardware version"; +if ( ! @ARGV ) { + v '07 02 00 00 00 04 C4', "hardware version"; -#v '07 0A 00 00 00 04 44', 'software version'; + v '07 0A 00 00 00 04 44', 'software version'; -v '07 00 01 00 06 0E EA', 'temperatures'; + v '07 00 01 00 06 0E EA', 'temperatures'; + v '07 00 00 00 26 0A A6', 'last errros'; +} + +#v '07 00 00 00 26 00 AC', 'last errros (with invalid length)'; + +foreach my $reg ( @ARGV ) { + warn "# send user $reg\n"; + v_bytes( + crc( hex2bytes( "07 00 00 00 $reg 01 FF" ) ) + ,"user: $reg"); +}