SCX/Parser.pm

   1 #!/usr/bin/perl -w
   2
   3 package SCX::Parser;
   4
   5 use strict;
   6 use SCX::CRC;
   7
   8 our $PACKET_SIZE = 9; # 9 bytes + 0x05
   9
  10 sub new {
  11         my ($class, $args) = @_;
  12
  13         my $self = {
  14                 bytes     => [],
  15                 now       => 0,
  16         };
  17
  18         bless $self, $class;
  19
  20         return $self;
  21 }
  22
  23 sub now { return shift->{now} }
  24
  25 sub add_data {
  26         my ($self, $time, @bytes) = @_;
  27
  28         push @{ $self->{bytes} }, @bytes;
  29         @bytes = @{ $self->{bytes} };
  30
  31         $self->{now} = $time;
  32
  33         my @bad_bytes;
  34
  35         while (@bytes > $PACKET_SIZE) {
  36                 if ($bytes[0] != 0x55) {
  37                         push @bad_bytes, shift @bytes;
  38                         next;
  39                 }
  40                 my $cmd = $bytes[1];
  41
  42                 if ($bytes[$PACKET_SIZE] != 0x05
  43                         || SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2])
  44                                 != $bytes[$PACKET_SIZE-1]) {
  45                         push @bad_bytes, shift @bytes;
  46                         next;
  47                 }
  48
  49                 if (@bad_bytes) { # Report previous bad bytes first
  50                         $self->bad_bytes(@bad_bytes);
  51                         @bad_bytes = ();
  52                 }
  53
  54                 my @packet = splice @bytes, 0, $PACKET_SIZE+1;
  55                 $self->log_packet(@packet);
  56                 $self->parse_packet(@packet);
  57         }
  58
  59         if (@bad_bytes) {
  60                 while (@bytes && $bytes[0] != 0x55) {
  61                         push @bad_bytes, shift @bytes;
  62                 }
  63                 $self->bad_bytes(@bad_bytes);
  64         }
  65
  66         @{ $self->{bytes} } = @bytes;
  67 }
  68
  69 # Subclass these:
  70
  71 sub log_packet { }
  72 sub bad_bytes { }
  73 sub unknown_packet { }
  74 sub strange_packet { }
  75
  76 sub bus_free_time { }
  77 sub car_programming { }
  78 sub reset { }
  79 sub standings { }
  80 sub car_lap_time { }
  81 sub race_setup { }
  82 sub fuel_level { }
  83 sub brake_set { }
  84 sub qualification { }
  85 sub end_of_race { }
  86 sub race_start { }
  87 sub display_change { }
  88 sub finish_line { }
  89 sub controller_status { }
  90
  91 our %COMMANDS = (
  92         0xAA => \&bus_free_time_packet,
  93         0xCC => \&car_programming_packet,
  94         0xD0 => \&reset_packet,
  95         0xD3 => \&standings_packet,
  96         0xD4 => \&car_lap_time_packet,
  97         0xD5 => \&race_setup_packet,
  98         0xD6 => \&fuel_level_packet,
  99         0xD7 => \&brake_set_packet,
 100         0xDB => \&qualification_packet,
 101         0xDC => \&end_of_race_packet,
 102         0xDD => \&race_start_packet,
 103         0xDE => \&display_change_packet,
 104         0xEE => \&finish_line_packet,
 105         0xFF => \&controller_status_packet,
 106 );
 107
 108 sub parse_packet {
 109         my ($self, @data) = @_;
 110
 111         my $cmd = $data[1];
 112         my @args = @data[2..7];
 113
 114         my $sub = $COMMANDS{$cmd};
 115
 116         if (!defined $sub) {
 117                 $self->unknown_packet($cmd, @args);
 118                 return;
 119         }
 120
 121         return &$sub($self, @args);
 122 }
 123
 124 sub bus_free_time_packet {
 125         my ($self, @bytes) = @_;
 126
 127         $self->strange_packet('bus free time', @bytes)
 128                 if $bytes[2] != 0xF0
 129                 || $bytes[3] != 0xF0
 130                 || $bytes[4] != 0xF0
 131                 || $bytes[5] != 0xF0;
 132
 133         $self->bus_free_time($bytes[1], $bytes[0]);
 134 }
 135
 136 sub car_programming_packet {
 137         my ($self, @bytes) = @_;
 138
 139         $self->strange_packet('car programming', @bytes)
 140                 if ($bytes[0] & 0xF8) != 0 || ($bytes[0] & 0x07) > 5
 141                 || $bytes[1] != 0xFE
 142                 || $bytes[2] != 0xFF
 143                 || $bytes[3] != 0xFF
 144                 || $bytes[4] != 0xFF
 145                 || $bytes[5] != 0xFF;
 146
 147         $self->car_programming($bytes[0] & 0x07);
 148 }
 149
 150 sub reset_packet {
 151         my ($self, @bytes) = @_;
 152
 153         $self->strange_packet('reset', @bytes)
 154                 if $bytes[0] != 0xFF
 155                 || $bytes[3] != 0xAA
 156                 || $bytes[4] != 0xAA
 157                 || $bytes[5] != 0xAA;
 158
 159         $self->reset($bytes[1], $bytes[2]);
 160 }
 161
 162 sub standings_packet {
 163         my ($self, @bytes) = @_;
 164
 165         self->strange_packet('standings', @bytes)
 166                 if ($bytes[0] != 0xFF && ($bytes[0] & 0x07) > 5)
 167                 || ($bytes[1] != 0xFF && ($bytes[1] & 0x07) > 5)
 168                 || ($bytes[2] != 0xFF && ($bytes[2] & 0x07) > 5)
 169                 || ($bytes[3] != 0xFF && ($bytes[3] & 0x07) > 5)
 170                 || ($bytes[4] != 0xFF && ($bytes[4] & 0x07) > 5)
 171                 || ($bytes[5] != 0xFF && ($bytes[5] & 0x07) > 5);
 172
 173         $self->standings(map { $_ != 0xFF ? $_ & (0x07) : () } @bytes);
 174 }
 175
 176 sub car_lap_time_packet {
 177         my ($self, @bytes) = @_;
 178
 179         $self->strange_packet('car lap time', @bytes)
 180                 if $bytes[0] > 5
 181                 || $bytes[1] & 0x01
 182                 || $bytes[2] & 0x01
 183                 || ($bytes[3] & 0xF0) != 0
 184                 || $bytes[4] & 0x01
 185                 || $bytes[5] & 0x01;
 186
 187         $self->car_lap_time($bytes[0],
 188                 256*$bytes[1] + $bytes[2]
 189                         + ($bytes[3] & 0x02 ? 256 : 0)
 190                         + ($bytes[3] & 0x01 ? 1 : 0),
 191                 sprintf('%.3f', 0.01024 * (256*$bytes[4] + $bytes[5]
 192                         + ($bytes[3] & 0x08 ? 256 : 0)
 193                         + ($bytes[3] & 0x04 ? 1 : 0))),
 194                 sprintf('%04b', $bytes[3])
 195         );
 196 }
 197
 198 sub race_setup_packet {
 199         my ($self, @bytes) = @_;
 200
 201         $self->strange_packet('race setup')
 202                 if ($bytes[0] != 0x00 && $bytes[0] != 0xFF)
 203                 || $bytes[1] & 0xF0
 204                 || $bytes[2] & 0xF0
 205                 || $bytes[3] & 0xF0
 206                 || $bytes[4] != 0xFF
 207                 || $bytes[5] != 0xFF;
 208
 209         my $rounds = $bytes[0] == 0x00
 210                 ? 0
 211                 : ($bytes[1] & 0x0F) * 256
 212                         + ($bytes[2] & 0x0F) * 16
 213                         + ($bytes[3] & 0x0F);
 214
 215         $self->race_setup($rounds);
 216 }
 217
 218 sub fuel_level_packet {
 219         my ($self, @bytes) = @_;
 220
 221         $self->strange_packet('fuel level')
 222                 if ($bytes[0] >> 4) > 8
 223                 || ($bytes[0] & 0x0F) > 8
 224                 || ($bytes[1] >> 4) > 8
 225                 || ($bytes[1] & 0x0F) > 8
 226                 || ($bytes[2] >> 4) > 8
 227                 || ($bytes[2] & 0x0F) > 8
 228                 || ($bytes[5] != 0xAA && $bytes[5] != 0xFF);
 229
 230         my @fuel = (
 231                 $bytes[0] >> 4, $bytes[0] & 0x0f,
 232                 $bytes[1] >> 4, $bytes[1] & 0x0f,
 233                 $bytes[2] >> 4, $bytes[2] & 0x0f,
 234         );
 235
 236         $self->fuel_level(@fuel);
 237 }
 238
 239 sub brake_set_packet {
 240         my ($self, @bytes) = @_;
 241
 242         $self->strange_packet('brake set')
 243                 if ($bytes[0] > 5)
 244                 || ($bytes[1] != 0x00 && $bytes[1] != 0x02 && $bytes[1] != 0x04)
 245                 || $bytes[2] != 0x83
 246                 || $bytes[3] != 0x93
 247                 || $bytes[4] != 0xDB
 248                 || $bytes[5] != 0xFF;
 249
 250         $self->brake_set($bytes[0],
 251                 $bytes[1] == 0x00 ? 0
 252                 : $bytes[1] == 0x02 ? 50
 253                 : 100);
 254 }
 255
 256 sub qualification_packet {
 257         my ($self, @bytes) = @_;
 258
 259         $self->strange_packet('qualification')
 260                 if $bytes[0] & 0xF0
 261                 || $bytes[1] & 0xF0
 262                 || $bytes[2] & 0xF0
 263                 || $bytes[3] > 6
 264                 || $bytes[4] != 0xFF
 265                 || $bytes[5] != 0xFF;
 266
 267         my $rounds = ($bytes[0] & 0x0F) * 256
 268                         + ($bytes[1] & 0x0F) * 16
 269                         + ($bytes[2] & 0x0F);
 270         my $cars = $bytes[3];
 271
 272         $self->qualification($rounds, $cars);
 273 }
 274
 275 sub end_of_race_packet {
 276         my ($self, @bytes) = @_;
 277
 278         $self->strange_packet('end of race')
 279                 if $bytes[0] != 0xFF
 280                 || $bytes[1] != 0xFF
 281                 || $bytes[2] != 0xFF
 282                 || $bytes[3] != 0xFF
 283                 || $bytes[4] != 0xFF
 284                 || $bytes[5] != 0xFF;
 285
 286         $self->end_of_race();
 287 }
 288
 289 sub race_start_packet {
 290         my ($self, @bytes) = @_;
 291
 292         $self->strange_packet('race start')
 293                 if $bytes[0] != 0x00
 294                 || $bytes[1] != 0xAA
 295                 || $bytes[2] != 0xAA
 296                 || $bytes[3] != 0xAA
 297                 || $bytes[4] != 0xAA
 298                 || $bytes[5] != 0xAA;
 299
 300         $self->race_start();
 301 }
 302
 303 sub display_change_packet {
 304         my ($self, @bytes) = @_;
 305
 306         $self->strange_packet('display change')
 307                 if $bytes[0] & 0xFE
 308                 || $bytes[1] != 0xFF
 309                 || $bytes[2] != 0xFF
 310                 || $bytes[3] != 0xFF
 311                 || $bytes[4] != 0xFF
 312                 || $bytes[5] != 0xFF;
 313
 314         $self->display_change();
 315 }
 316
 317 =comment
 318
 319 # FIXME: we still do not know the meaning of the bytes
 320 sub finish_line_packet {
 321         my ($self, @bytes) = @_;
 322
 323         my $fail;
 324         for my $byte (@bytes) {
 325                 $fail = 1
 326                         if $byte != 0xAA
 327                         && $byte != 0xE7
 328                         && $byte != 0xF0
 329                         && $byte != 0xFE
 330         }
 331
 332         my $msg = 'Strange finish_line packet'
 333                 if $fail;
 334
 335         my $regular = 1;
 336         my @cars_finished;
 337         for my $i (0..5) {
 338                 my $byte = $bytes[$i];
 339
 340                 $regular = 0
 341                         if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE;
 342
 343                 push @cars_finished, $i if $byte == 0xE7;
 344         }
 345
 346         $self->log_cmd('finish_line', $regular, @cars_finished);
 347         $self->track->finish_line(
 348                 $self->{last_read_time},
 349                 $regular,
 350                 @cars_finished
 351         );
 352
 353         return $msg;
 354 }
 355 =cut
 356
 357 sub finish_line_packet {
 358         my ($self, @bytes) = @_;
 359
 360         my $fail;
 361         for my $byte (@bytes) {
 362                 $fail = 1
 363                         if $byte != 0xAA
 364                         && $byte != 0xE7
 365                         && $byte != 0xF0
 366                         && $byte != 0xFE
 367         }
 368
 369         $self->strange_packet('finish line')
 370                 if $fail;
 371
 372         my $regular = 1;
 373         my @cars_finished;
 374         for my $i (0..5) {
 375                 my $byte = $bytes[$i];
 376
 377                 $regular = 0
 378                         if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE;
 379
 380                 push @cars_finished, $i if $byte == 0xE7;
 381         }
 382
 383         $self->finish_line($regular, @cars_finished);
 384 }
 385
 386 sub controller_status_packet {
 387         my ($self, @bytes) = @_;
 388
 389         my $fail;
 390         for my $byte (@bytes) {
 391                 next if $byte == 0xAA;
 392                 $fail = 1
 393                         if ($byte & 0xC0) != 0xC0
 394                         || ($byte & 0x0F) > 12
 395         }
 396
 397         $self->strange_packet('controller status')
 398                 if $fail;
 399
 400         my @ctrl_data;
 401
 402         for my $car (0..5) {
 403                 my $byte = $bytes[$car];
 404
 405                 if ($byte == 0xAA) {
 406                         push @ctrl_data, undef;
 407                         next;
 408                 }
 409
 410                 my $light = ($byte & 0x20) ? 0 : 1;
 411                 my $backbutton = ($byte & 0x10) ? 0 : 1;
 412                 my $throttle = $byte & 0x0f;
 413
 414                 push @ctrl_data, {
 415                         throttle => $throttle,
 416                         button   => $backbutton,
 417                         light    => $light,
 418                 };
 419         }
 420
 421         $self->controller_status(@ctrl_data);
 422 }
 423
 424 1;
 425