#!/usr/bin/perl -w package SCX::Reader; use Time::HiRes qw(gettimeofday tv_interval); use FileHandle; use SCX::CRC; our $PACKET_SIZE = 9; # 9 bytes + 0x05 our $LOG_ROTATE = 600; sub new { my ($class, $args) = @_; my $callback = $args->{callback} or die "callback arg not defined"; my $portname = $args->{portname} or die "portname not specified"; system 'stty', '-F', $portname, '115200', 'raw'; if ($?) { die "stty died with code $? (no permissions?)"; } open my $tty, '<:raw', $portname or die "Can't open $portname: $!"; my $logfile = $args->{logfile}; my $log_gen = 0; open my $logfh, '>', "$logfile.$log_gen" or die "Can't open $logfile.$log_gen: $!"; my $now = gettimeofday; my $self = { portname => $portname, fh => $tty, logfile => $logfile, logfh => $logfh, log_gen => $log_gen, log_start => $now, starttime => $now, track => $track, bytes => [], }; bless $self, $class; return $self; } sub fh { return shift->{fh}; } sub read { my ($self) = @_; my $data; my $bytes_read = sysread $self->fh, $data, $PACKET_SIZE; die "Read error on $self->{portname}: $!" if !$bytes_read; my @bytes = unpack("C*", $data); push @{ $self->{bytes} }, @bytes; @bytes = @{ $self->{bytes} }; my @bad_bytes; while (@bytes > $PACKET_SIZE) { if ($bytes[0] != 0x55) { push @bad_bytes, shift @bytes; next; } my $cmd = $bytes[1]; if ($bytes[$PACKET_SIZE] != 0x05 || SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2]) != $bytes[$PACKET_SIZE-1]) { push @bad_bytes, shift @bytes; next; } if (@bad_bytes) { # Report previous bad bytes first $self->log_bytes(\@bad_bytes, "Cannot parse packet"); @bad_bytes = (); } my @packet = splice @bytes, 0, $PACKET_SIZE+1; my $rv = &{ $self->{callback} }(@packet); $self->log_bytes(@packet, $rv); } $self->log_bad_bytes(\@bad_bytes, "Cannot parse packet"); @{ $self->{bytes} } = @bytes; } sub log_bytes { my ($self, $bytes, $msg) = @_; return if !@$bytes; $msg = defined $msg ? ' # ' . $msg : ''; my $now = gettimeofday; if ($now - $self->{log_start} >= $LOG_ROTATE) { close $self->{logfh}; $self->{log_gen} = $self->{log_gen} ? 0 : 1; open my $fh, '>', $logfile . '.' . $self->{log_gen} or die "Can't open $logfile.$self->{log_gen}: $!"; $self->{logfh} = $fh; $self->{log_start} = $now; } $self->{logfh}->print(sprintf('% 10.3f', $now - $self->{starttime}), (map { sprintf(" %02x", $_) } @$bytes), $msg, "\n"); } our %COMMANDS = ( 0xAA => \&bus_free_time_packet, 0xCC => \&car_programming_packet, 0xD0 => \&reset_packet, 0xD3 => \&standings_packet, 0xD4 => \&lap_time_packet, 0xD5 => \&race_setup_packet, 0xD6 => \&fuel_level_packet, 0xD7 => \&brake_set_packet, 0xDB => \&qualification_packet, 0xDC => \&end_of_race_packet, 0xDD => \&race_start_packet, 0xDE => \&display_change_packet, 0xEE => \&finish_line_packet, 0xFF => \&controller_status_packet, ); sub handle_packet { my ($self, @data) = @_; my $cmd = $data[1]; my @args = $data[2..7]; my $sub = $COMMANDS{$cmd}; return "Unknown packet" if !defined $sub; return &$sub($self, @args); } sub bus_free_time_packet { my ($self, @bytes) = @_; my $msg = 'Strange bus free time packet' if $bytes[2] != 0xF0 || $bytes[3] != 0xF0 || $bytes[4] != 0xF0 || $bytes[5] != 0xF0; return $msg; # No need to handle this, I think } sub car_programming_packet { my ($self, @bytes) = @_; my $msg = 'Strange car programming packet' if $bytes[0] & 0xF8 != 0 || $bytes[0] & 0x07 > 5 || $bytes[1] != 0xFE || $bytes[2] != 0xFF || $bytes[3] != 0xFF || $bytes[4] != 0xFF || $bytes[5] != 0xFF; return $msg; } sub reset_packet { my ($self, @bytes) = @_; my $msg = 'Strange reset packet' if $bytes[0] != 0xFF || $bytes[3] != 0xAA || $bytes[4] != 0xAA || $bytes[5] != 0xAA; return $msg; # FIXME - to be implemented } sub standings_packet { my ($self, @bytes) = @_; my $msg = 'Strange standings packet' if $bytes[0] & 0x07 > 5 || $bytes[1] & 0x07 > 5 || $bytes[2] & 0x07 > 5 || $bytes[3] & 0x07 > 5 || $bytes[4] & 0x07 > 5 || $bytes[5] & 0x07 > 5; return $msg; # FIXME - to be implemented } sub lap_time_packet { my ($self, @bytes) = @_; my $msg = 'Strange lap time packet' if $bytes[0] > 5 || $bytes[1] & 0x01 || $bytes[2] & 0x01 || $bytes[3] & 0xF8 != 0 || $bytes[4] & 0x01 || $bytes[5] & 0x01; return $msg; # FIXME - to be implemented } sub race_setup_packet { my ($self, @bytes) = @_; my $msg = 'Strange race setup packet' if ($bytes[0] != 0x00 && $bytes[0] != 0xFF) || $bytes[1] & 0xF0 || $bytes[2] & 0xF0 || $bytes[3] & 0xF0 || $bytes[4] != 0xFF || $bytes[5] != 0xFF; return $msg; # FIXME - to be implemented } sub fuel_level_packet { my ($self, @bytes) = @_; my $msg = 'Strange fuel_level packet' if ($bytes[0] >> 4) > 8 || $bytes[0] & 0x0F > 8 || ($bytes[1] >> 4) > 8 || $bytes[1] & 0x0F > 8 || ($bytes[2] >> 4) > 8 || $bytes[2] & 0x0F > 8 || ($bytes[5] != 0xAA && $bytes[5] != 0xFF); my @fuel = ( $bytes[1] >> 4, $bytes[1] & 0x0f, $bytes[2] >> 4, $bytes[2] & 0x0f, $bytes[3] >> 4, $bytes[3] & 0x0f, ); for my $car (0..5) { $track->car($car)->set_fuel($fuel[$car]); } return $msg; } sub brake_set_packet { my ($self, @bytes) = @_; return 'Unexpected brake_set packet (should be in the pit lane only)'; } sub qualification_packet { my ($self, @bytes) = @_; my $msg = 'Strange qualification packet' if $bytes[0] & 0xF0 || $bytes[1] & 0xF0 || $bytes[2] & 0xF0 || $bytes[3] > 5 || $bytes[4] != 0xFF || $bytes[5] != 0xFF; return $msg; # FIXME - to be implemented } sub end_of_race_packet { my ($self, @bytes) = @_; my $msg = 'Strange end_of_race packet' if $bytes[0] != 0xFF || $bytes[1] != 0xFF || $bytes[2] != 0xFF || $bytes[3] != 0xFF || $bytes[4] != 0xFF || $bytes[5] != 0xFF; return $msg; # FIXME - to be implemented } sub race_start_packet { my ($self, @bytes) = @_; my $msg = 'Strange race_start packet' if $bytes[0] != 0x00 || $bytes[1] != 0xAA || $bytes[2] != 0xAA || $bytes[3] != 0xAA || $bytes[4] != 0xAA || $bytes[5] != 0xAA; return $msg; # FIXME - to be implemented } sub display_change_packet { my ($self, @bytes) = @_; my $msg = 'Strange display_change packet' if $bytes[0] & 0xFE || $bytes[1] != 0xFF || $bytes[2] != 0xFF || $bytes[3] != 0xFF || $bytes[4] != 0xFF || $bytes[5] != 0xFF; return $msg; # FIXME - to be implemented } sub finish_line_packet { my ($self, @bytes) = @_; my $fail; for my $byte (@bytes) { $fail = 1 if $byte != 0xAA && $byte != 0xE7 && $byte != 0xF0 && $byte != 0xFE } my $msg = 'Strange finish_line packet' if $fail; return $msg; # FIXME - to be implemented } sub controller_status_packet { my ($self, @bytes) = @_; my $fail; for my $byte (@bytes) { $fail = 1 if $byte & 0xC0 != 0xC0 || $byte & 0x0F > 12 } my $msg = 'Strange controller_status packet' if $fail; my @fuel = ( $bytes[1] >> 4, $bytes[1] & 0x0f, $bytes[2] >> 4, $bytes[2] & 0x0f, $bytes[3] >> 4, $bytes[3] & 0x0f, ); for my $car (0..5) { my $byte = $bytes[$car]; if ($byte == 0xAA) { $track->car($car)->set_throttle(undef); next; } my $light = !($byte & 0x20); my $backbutton = !($byte & 0x10); my $throttle = $byte & 0x0f; $track->car($car)->set_throttle($throttle); $track->car($car)->set_light($light); $track->car($car)->set_backbutton($backbutton); } return $msg; } 1;