git.rot13.org Git - vrDialog/blob - dialog.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Data::Dump qw(dump);
   6 use Device::SerialPort qw(:STAT);
   7
   8 my $debug = $ENV{DEBUG} || 0;
   9
  10 my $port = Device::SerialPort->new('/dev/ttyUSB0');
  11 die "can't open serial port" unless $port;
  12 $port->baudrate(9600);
  13 $port->databits(8);
  14 $port->parity('none');
  15 $port->stopbits(1);
  16 $port->handshake('none');
  17
  18 $port->read_char_time(500);
  19 $port->read_const_time(1000);
  20
  21 sub read_serial {
  22         my $len = shift;
  23         return $port->read( $len );
  24 }
  25
  26 sub write_serial {
  27         my $bytes = shift;
  28         return $port->write( $bytes );
  29 }
  30
  31 # TODO: implement remote serial port
  32 # remserial -x 2 -p 23000 -s "9600 raw" /dev/ttyUSB0
  33
  34 sub as_hex {
  35         my @out;
  36         foreach my $str ( @_ ) {
  37                 my $hex = uc unpack( 'H*', $str );
  38                 $hex =~ s/(..)/$1 /g if length( $str ) > 2;
  39                 $hex =~ s/\s+$//;
  40                 push @out, $hex;
  41         }
  42         return join(' | ', @out);
  43 }
  44
  45 sub hex2bytes {
  46         my $bytes;
  47         $bytes .= pack('C', hex('0x' . $_)) foreach split(/\s+/,join(' ',@_));
  48         return $bytes;
  49 }
  50
  51 sub crc {
  52         my $data = shift;
  53         my $crc = 0;
  54         for my $i ( 0 .. length($data) - 2 ) {
  55                 if ( $crc & 0x80 ) {
  56                         $crc = ( $crc << 1 ) ^ 25;
  57                 } else {
  58                         $crc = $crc << 1;
  59                 }
  60                 $crc = $crc & 0xff;
  61                 my $byte = ord(substr($data,$i,1));
  62                 $crc = $crc ^ $byte;
  63 #               warn "## ", as_hex(chr($byte)), " crc = ", $crc, " ", as_hex(chr($crc));
  64         }
  65         # ignore checksum errors for FF, we will calulate them!
  66         if ( chr($crc) ne substr($data,-1,1) && substr($data,-1,1) ne "\xFF" ) {
  67                 warn "CRC error for ",as_hex($data), " calulated ", as_hex(chr($crc));
  68         }
  69
  70         return substr($data,0,-1) . chr($crc);
  71 }
  72
  73 sub v_bytes {
  74         my ($bytes,$desc) = @_;
  75         warn "# $desc\n";
  76 retry:
  77         warn ">> ",as_hex( $bytes );
  78         crc( $bytes );
  79         write_serial( $bytes );
  80
  81         my $data = read_serial(1);
  82         warn "<< len: ",ord($data) if $debug;
  83
  84         goto retry if ord($data) == 0;
  85
  86         $data .= read_serial(ord($data) - 1);
  87         crc($data);
  88         warn "<< ",as_hex($data);
  89
  90         my $o = 2;
  91         while ( $o < length($data) - 2 ) {
  92                 my $n = unpack('n', substr($data,$o,2));
  93                 $n = -( 0xffff - $n ) if $n & 0x8000;
  94                 warn "## $o = ",$n, "\t",$n / 16,"\n";
  95                 $o += 2;
  96         }
  97
  98         while ( $o < length($data) - 1 ) {
  99                 my $n = unpack('c', substr($data,$o,1));
 100                 warn "## $o = ", $n, "\n";
 101                 $o += 1;
 102         }
 103
 104         return $data;
 105 }
 106
 107 sub v {
 108         my ($hex,$desc) = @_;
 109         v_bytes( hex2bytes( $hex ), $desc );
 110 }
 111
 112 if ( ! @ARGV ) {
 113         v '07 02 00 00 00 04 C4', "hardware version";
 114
 115         v '07 0A 00 00 00 04 44', 'software version';
 116
 117         v '07 00 01 00 06 0E EA', 'temperatures';
 118
 119         v '07 00 00 00 26 0A A6', 'last errros';
 120 }
 121
 122 #v '07 00 00 00 26 00 AC', 'last errros (with invalid length)';
 123
 124 foreach my $reg ( @ARGV ) {
 125         warn "# send user $reg\n";
 126         v_bytes(
 127                 crc( hex2bytes( "07 00 00 00 $reg 01 FF" ) )
 128         ,"user: $reg");
 129 }