SCX/Reader.pm

   1 #!/usr/bin/perl -w
   2
   3 package SCX::Reader;
   4
   5 use strict;
   6
   7 use Time::HiRes qw(gettimeofday tv_interval);
   8 use FileHandle;
   9 use IO::Handle;
  10 use POSIX;
  11 use SCX::CRC;
  12
  13 our $PACKET_SIZE = 9; # 9 bytes + 0x05
  14 our $LOG_FILE_LIMIT = 10_000_000; # bytes
  15
  16 sub new {
  17         my ($class, $args) = @_;
  18
  19         my $portname = $args->{portname}
  20                 or die "portname not specified";
  21
  22         system 'stty', '-F', $portname, '115200', 'raw';
  23         if ($?) {
  24                 die "stty died with code $? (no permissions?)";
  25         }
  26
  27         sysopen(my $fh, $portname, O_RDONLY|O_NONBLOCK)
  28                 or die "Can't open $portname: $!";
  29
  30         my $logfile = $args->{logfile};
  31         my $log_gen = 0;
  32
  33         open my $logfh, '>', "$logfile.$log_gen"
  34         or die "Can't open $logfile.$log_gen: $!";
  35
  36         my $self = {
  37                 portname  => $portname,
  38                 fh        => $fh,
  39                 logfile   => $logfile,
  40                 logfh     => $logfh,
  41                 log_gen   => $log_gen,
  42                 track     => $args->{track},
  43                 bytes     => [],
  44         };
  45
  46         bless $self, $class;
  47
  48         return $self;
  49 }
  50
  51 sub fh { return shift->{fh}; }
  52
  53 sub track { return shift->{track}; }
  54
  55 sub read {
  56         my ($self) = @_;
  57
  58         my $data;
  59         my $bytes_read = sysread $self->fh, $data, $PACKET_SIZE;
  60         die "Read error on $self->{portname}: $!"
  61                 if !$bytes_read;
  62
  63         $self->{last_read_time} = gettimeofday;
  64
  65         my @bytes = unpack("C*", $data);
  66
  67         # print join(' ', map { sprintf(" %02x", $_) } @bytes), "\n";
  68         push @{ $self->{bytes} }, @bytes;
  69         @bytes = @{ $self->{bytes} };
  70
  71         my @bad_bytes;
  72
  73         while (@bytes > $PACKET_SIZE) {
  74                 if ($bytes[0] != 0x55) {
  75                         push @bad_bytes, shift @bytes;
  76                         next;
  77                 }
  78                 my $cmd = $bytes[1];
  79
  80                 if ($bytes[$PACKET_SIZE] != 0x05
  81                         || SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2])
  82                                 != $bytes[$PACKET_SIZE-1]) {
  83                         push @bad_bytes, shift @bytes;
  84                         next;
  85                 }
  86
  87                 if (@bad_bytes) { # Report previous bad bytes first
  88                         $self->log_bytes(\@bad_bytes, "Cannot parse packet");
  89                         @bad_bytes = ();
  90                 }
  91
  92                 my @packet = splice @bytes, 0, $PACKET_SIZE+1;
  93                 my $rv = $self->handle_packet(@packet);
  94                 $self->log_bytes(\@packet, $rv);
  95                 $self->track->packet_received($self->{last_read_time});
  96         }
  97
  98         if (@bad_bytes) {
  99                 while (@bytes && $bytes[0] != 0x55) {
 100                         push @bad_bytes, shift @bytes;
 101                 }
 102                 $self->log_bytes(\@bad_bytes, "cannot parse packet");
 103         }
 104
 105         @{ $self->{bytes} } = @bytes;
 106 }
 107
 108 sub log_print {
 109         my ($self, @data) = @_;
 110
 111         my $size = $self->{logfh}->tell;
 112
 113         if ($size >= $LOG_FILE_LIMIT) {
 114                 close $self->{logfh};
 115                 $self->{log_gen} = $self->{log_gen} ? 0 : 1;
 116                 open my $fh, '>', $self->{logfile} . '.' . $self->{log_gen}
 117                         or die "Can't open $self->{logfile}.$self->{log_gen}: $!";
 118                 $self->{logfh} = $fh;
 119         }
 120
 121         $self->{logfh}->print(sprintf('% 10.3f ', $self->{last_read_time}),
 122                 join(' ', @data, "\n"));
 123         $self->{logfh}->flush;
 124 }
 125
 126 sub log_bytes {
 127         my ($self, $bytes, $msg) = @_;
 128
 129         return if !@$bytes;
 130
 131         $msg = defined $msg ? '# ' . $msg : '';
 132
 133         $self->log_print((map { sprintf("%02x", $_) } @$bytes), $msg);
 134 }
 135
 136 sub log_cmd {
 137         my ($self, @args) = @_;
 138
 139         $self->log_print('cmd', @args);
 140 }
 141
 142 our %COMMANDS = (
 143         0xAA => \&bus_free_time_packet,
 144         0xCC => \&car_programming_packet,
 145         0xD0 => \&reset_packet,
 146         0xD3 => \&standings_packet,
 147         0xD4 => \&lap_time_packet,
 148         0xD5 => \&race_setup_packet,
 149         0xD6 => \&fuel_level_packet,
 150         0xD7 => \&brake_set_packet,
 151         0xDB => \&qualification_packet,
 152         0xDC => \&end_of_race_packet,
 153         0xDD => \&race_start_packet,
 154         0xDE => \&display_change_packet,
 155         0xEE => \&finish_line_packet,
 156         0xFF => \&controller_status_packet,
 157 );
 158
 159 sub handle_packet {
 160         my ($self, @data) = @_;
 161
 162         my $cmd = $data[1];
 163         my @args = @data[2..7];
 164
 165         my $sub = $COMMANDS{$cmd};
 166         return "Unknown packet"
 167                 if !defined $sub;
 168
 169         return &$sub($self, @args);
 170 }
 171
 172 sub bus_free_time_packet {
 173         my ($self, @bytes) = @_;
 174
 175         my $msg = 'Strange bus free time packet'
 176                 if $bytes[2] != 0xF0
 177                 || $bytes[3] != 0xF0
 178                 || $bytes[4] != 0xF0
 179                 || $bytes[5] != 0xF0;
 180
 181         return $msg; # No need to handle this, I think
 182 }
 183
 184 sub car_programming_packet {
 185         my ($self, @bytes) = @_;
 186
 187         my $msg = 'Strange car programming packet'
 188                 if ($bytes[0] & 0xF8) != 0 || ($bytes[0] & 0x07) > 5
 189                 || $bytes[1] != 0xFE
 190                 || $bytes[2] != 0xFF
 191                 || $bytes[3] != 0xFF
 192                 || $bytes[4] != 0xFF
 193                 || $bytes[5] != 0xFF;
 194
 195         return $msg; # No need to handle this
 196 }
 197
 198 sub reset_packet {
 199         my ($self, @bytes) = @_;
 200
 201         my $msg = 'Strange reset packet'
 202                 if $bytes[0] != 0xFF
 203                 || $bytes[3] != 0xAA
 204                 || $bytes[4] != 0xAA
 205                 || $bytes[5] != 0xAA;
 206
 207         $self->log_cmd('reset');
 208         $self->track->reset;
 209
 210         return $msg;
 211 }
 212
 213 sub standings_packet {
 214         my ($self, @bytes) = @_;
 215
 216         my $msg = 'Strange standings packet'
 217                 if ($bytes[0] != 0xFF && ($bytes[0] & 0x07) > 5)
 218                 || ($bytes[1] != 0xFF && ($bytes[1] & 0x07) > 5)
 219                 || ($bytes[2] != 0xFF && ($bytes[2] & 0x07) > 5)
 220                 || ($bytes[3] != 0xFF && ($bytes[3] & 0x07) > 5)
 221                 || ($bytes[4] != 0xFF && ($bytes[4] & 0x07) > 5)
 222                 || ($bytes[5] != 0xFF && ($bytes[5] & 0x07) > 5);
 223
 224         my @standings;
 225
 226         push @standings, map { $_ != 0xFF ? $_ & (0x07) : () } @bytes;
 227
 228         return $msg; # We do internal standings handling
 229 }
 230
 231 sub lap_time_packet {
 232         my ($self, @bytes) = @_;
 233
 234         my $msg = 'Strange lap time packet'
 235                 if $bytes[0] > 5
 236                 || $bytes[1] & 0x01
 237                 || $bytes[2] & 0x01
 238                 || ($bytes[3] & 0xF0) != 0
 239                 || $bytes[4] & 0x01
 240                 || $bytes[5] & 0x01;
 241
 242         return $msg;
 243 }
 244
 245 sub race_setup_packet {
 246         my ($self, @bytes) = @_;
 247
 248         my $msg = 'Strange race setup packet'
 249                 if ($bytes[0] != 0x00 && $bytes[0] != 0xFF)
 250                 || $bytes[1] & 0xF0
 251                 || $bytes[2] & 0xF0
 252                 || $bytes[3] & 0xF0
 253                 || $bytes[4] != 0xFF
 254                 || $bytes[5] != 0xFF;
 255
 256         my $rounds = $bytes[0] == 0x00
 257                 ? 0
 258                 : ($bytes[1] & 0x0F) * 256
 259                         + ($bytes[2] & 0x0F) * 16
 260                         + ($bytes[3] & 0x0F);
 261
 262         $self->log_cmd('race_setup', $rounds);
 263         $self->track->race_setup($rounds);
 264
 265         return $msg;
 266 }
 267
 268 sub fuel_level_packet {
 269         my ($self, @bytes) = @_;
 270
 271         my $msg = 'Strange fuel_level packet'
 272                 if ($bytes[0] >> 4) > 8
 273                 || ($bytes[0] & 0x0F) > 8
 274                 || ($bytes[1] >> 4) > 8
 275                 || ($bytes[1] & 0x0F) > 8
 276                 || ($bytes[2] >> 4) > 8
 277                 || ($bytes[2] & 0x0F) > 8
 278                 || ($bytes[5] != 0xAA && $bytes[5] != 0xFF);
 279
 280         my @fuel = (
 281                 $bytes[0] >> 4, $bytes[0] & 0x0f,
 282                 $bytes[1] >> 4, $bytes[1] & 0x0f,
 283                 $bytes[2] >> 4, $bytes[2] & 0x0f,
 284         );
 285
 286         $self->log_cmd('fuel', @fuel);
 287         for my $car (0..5) {
 288                 $self->track->car($car)->set_fuel($fuel[$car]);
 289         }
 290
 291         return $msg;
 292 }
 293
 294
 295 sub brake_set_packet {
 296         my ($self, @bytes) = @_;
 297
 298         return 'Unexpected brake_set packet (should be in the pit lane only)';
 299 }
 300
 301
 302 sub qualification_packet {
 303         my ($self, @bytes) = @_;
 304
 305         my $msg = 'Strange qualification packet'
 306                 if $bytes[0] & 0xF0
 307                 || $bytes[1] & 0xF0
 308                 || $bytes[2] & 0xF0
 309                 || $bytes[3] > 5
 310                 || $bytes[4] != 0xFF
 311                 || $bytes[5] != 0xFF;
 312
 313         $self->log_cmd('qualification_start');
 314         $self->track->qualification_start;
 315
 316         return $msg;
 317 }
 318
 319
 320 sub end_of_race_packet {
 321         my ($self, @bytes) = @_;
 322
 323         my $msg = 'Strange end_of_race packet'
 324                 if $bytes[0] != 0xFF
 325                 || $bytes[1] != 0xFF
 326                 || $bytes[2] != 0xFF
 327                 || $bytes[3] != 0xFF
 328                 || $bytes[4] != 0xFF
 329                 || $bytes[5] != 0xFF;
 330
 331         $self->log_cmd('race_end');
 332         $self->track->race_end;
 333
 334         return $msg;
 335 }
 336
 337
 338 sub race_start_packet {
 339         my ($self, @bytes) = @_;
 340
 341         my $msg = 'Strange race_start packet'
 342                 if $bytes[0] != 0x00
 343                 || $bytes[1] != 0xAA
 344                 || $bytes[2] != 0xAA
 345                 || $bytes[3] != 0xAA
 346                 || $bytes[4] != 0xAA
 347                 || $bytes[5] != 0xAA;
 348
 349         $self->log_cmd('race_start');
 350         $self->track->race_start;
 351
 352         return $msg;
 353 }
 354
 355
 356 sub display_change_packet {
 357         my ($self, @bytes) = @_;
 358
 359         my $msg = 'Strange display_change packet'
 360                 if $bytes[0] & 0xFE
 361                 || $bytes[1] != 0xFF
 362                 || $bytes[2] != 0xFF
 363                 || $bytes[3] != 0xFF
 364                 || $bytes[4] != 0xFF
 365                 || $bytes[5] != 0xFF;
 366
 367         return $msg; # FIXME - to be implemented
 368 }
 369
 370
 371 sub finish_line_packet {
 372         my ($self, @bytes) = @_;
 373
 374         my $fail;
 375         for my $byte (@bytes) {
 376                 $fail = 1
 377                         if $byte != 0xAA
 378                         && $byte != 0xE7
 379                         && $byte != 0xF0
 380                         && $byte != 0xFE
 381         }
 382
 383         my $msg = 'Strange finish_line packet'
 384                 if $fail;
 385
 386         my $regular = 1;
 387         my @cars_finished;
 388         for my $i (0..5) {
 389                 my $byte = $bytes[$i];
 390
 391                 $regular = 0
 392                         if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE;
 393
 394                 push @cars_finished, $i if $byte == 0xE7;
 395         }
 396
 397         $self->log_cmd('finish_line', $regular, @cars_finished);
 398         $self->track->finish_line(
 399                 $self->{last_read_time},
 400                 $regular,
 401                 @cars_finished
 402         );
 403
 404         return $msg;
 405 }
 406
 407 sub controller_status_packet {
 408         my ($self, @bytes) = @_;
 409
 410         my $fail;
 411         for my $byte (@bytes) {
 412                 next if $byte == 0xAA;
 413                 $fail = 1
 414                         if ($byte & 0xC0) != 0xC0
 415                         || ($byte & 0x0F) > 12
 416         }
 417
 418         my $msg = 'Strange controller_status packet'
 419                 if $fail;
 420
 421         my @log_data;
 422
 423         for my $car (0..5) {
 424                 my $byte = $bytes[$car];
 425
 426                 if ($byte == 0xAA) {
 427                         $self->track->car($car)->set_throttle(undef, undef,
 428                                 $self->{last_read_time});
 429                         push @log_data, 'undef', '0';
 430                         next;
 431                 }
 432
 433                 my $light = !($byte & 0x20);
 434                 my $backbutton = !($byte & 0x10);
 435                 my $throttle = $byte & 0x0f;
 436
 437                 push @log_data, $throttle, $backbutton ? 1 : 0;
 438                 $self->track->car($car)->set_throttle($throttle, $backbutton,
 439                         $self->{last_read_time});
 440                 $self->track->car($car)->set_light($light);
 441         }
 442
 443         $self->log_cmd('throttle', @log_data);
 444
 445         return $msg;
 446 }
 447
 448 1;
 449