SCX/Reader.pm

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