X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?a=blobdiff_plain;f=SCX%2FReader.pm;h=873ffa058a09a451b217df87ed47196bd1efc37a;hb=3a515aa5d4aeeedf2632ddfc25ba4834ee90493d;hp=5a98a6d281ca7c22e97c444cddab0885003b1caf;hpb=68ff3ebd0073097de84fc55b22047cb5b9d98db7;p=slotcarman.git diff --git a/SCX/Reader.pm b/SCX/Reader.pm index 5a98a6d..873ffa0 100644 --- a/SCX/Reader.pm +++ b/SCX/Reader.pm @@ -2,19 +2,20 @@ package SCX::Reader; +use strict; + use Time::HiRes qw(gettimeofday tv_interval); use FileHandle; +use IO::Handle; +use POSIX; use SCX::CRC; -our $PACKET_SIZE = 10; +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"; @@ -23,7 +24,7 @@ sub new { die "stty died with code $? (no permissions?)"; } - open my $tty, '<:raw', $portname + sysopen(my $fh, $portname, O_RDONLY|O_NONBLOCK) or die "Can't open $portname: $!"; my $logfile = $args->{logfile}; @@ -36,13 +37,13 @@ sub new { my $self = { portname => $portname, - fh => $tty, + fh => $fh, logfile => $logfile, logfh => $logfh, log_gen => $log_gen, log_start => $now, starttime => $now, - callback => $callback, + track => $args->{track}, bytes => [], }; @@ -53,6 +54,8 @@ sub new { sub fh { return shift->{fh}; } +sub track { return shift->{track}; } + sub read { my ($self) = @_; @@ -61,64 +64,350 @@ sub read { die "Read error on $self->{portname}: $!" if !$bytes_read; - 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; - } - my @bytes = unpack("C*", $data); - $self->{logfh}->print(sprintf('% 10.3f', $now - $self->{starttime}), - (map { sprintf(" %02x", $_) } @bytes), - "\n"); - + # print join(' ', map { sprintf(" %02x", $_) } @bytes), "\n"; push @{ $self->{bytes} }, @bytes; @bytes = @{ $self->{bytes} }; my @bad_bytes; - while (@bytes >= 2) { + while (@bytes > $PACKET_SIZE) { if ($bytes[0] != 0x55) { push @bad_bytes, shift @bytes; next; } my $cmd = $bytes[1]; - my $packet_size = $cmd >= 0x40 && $cmd <= 0x46 ? 4 : 9; - last if @bytes <= $packet_size; - - if ($bytes[$packet_size] != 0x05 - || SCX::CRC::digest(@bytes[0..$packet_size-2]) - != $bytes[$packet_size-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) { - $self->{logfh}->print("Cannot parse bytes", - (map { sprintf(' %02x', $_) } @bad_bytes), - "\n"); + if (@bad_bytes) { # Report previous bad bytes first + $self->log_bytes(\@bad_bytes, "Cannot parse packet"); @bad_bytes = (); } - $self->{logfh}->print("Callback\n"); - &{ $self->{callback} }(@bytes[1..$packet_size]); - splice @bytes, 0, $packet_size+1; + my @packet = splice @bytes, 0, $PACKET_SIZE+1; + my $rv = $self->handle_packet(@packet); + $self->log_bytes(\@packet, $rv); } if (@bad_bytes) { - $self->{logfh}->print("Cannot parse bytes", - (map { sprintf(' %02x', $_) } @bad_bytes), - "\n"); - @bad_bytes = (); + while (@bytes && $bytes[0] != 0x55) { + push @bad_bytes, shift @bytes; + } + $self->log_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, '>', $self->{logfile} . '.' . $self->{log_gen} + or die "Can't open $self->{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"); + $self->{logfh}->flush; +} + +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] != 0xFF && ($bytes[0] & 0x07) > 5) + || ($bytes[1] != 0xFF && ($bytes[1] & 0x07) > 5) + || ($bytes[2] != 0xFF && ($bytes[2] & 0x07) > 5) + || ($bytes[3] != 0xFF && ($bytes[3] & 0x07) > 5) + || ($bytes[4] != 0xFF && ($bytes[4] & 0x07) > 5) + || ($bytes[5] != 0xFF && ($bytes[5] & 0x07) > 5); + + my @standings; + + push @standings, map { $_ != 0xFF ? $_ & (0x07) : () } @bytes; + + 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] & 0xF0) != 0 + || $bytes[4] & 0x01 + || $bytes[5] & 0x01; + + my $car = $bytes[0]; + my $round = 256*$bytes[1] + $bytes[2] + + ($bytes[3] & 2 ? 256 : 0) + + ($bytes[3] & 1 ? 1 : 0); + my $time = 256*$bytes[4] + $bytes[5] + + ($bytes[3] & 8 ? 256 : 0) + + ($bytes[3] & 4 ? 1 : 0); + $time *= 0.01024; + + $self->track->car($car)->set_lap($round); + $self->track->car($car)->set_laptime($time); + + return $msg; +} + + +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[0] >> 4, $bytes[0] & 0x0f, + $bytes[1] >> 4, $bytes[1] & 0x0f, + $bytes[2] >> 4, $bytes[2] & 0x0f, + ); + + for my $car (0..5) { + $self->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) { + next if $byte == 0xA0; + $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) { + $self->track->car($car)->set_throttle(undef); + next; + } + + my $light = !($byte & 0x20); + my $backbutton = !($byte & 0x10); + my $throttle = $byte & 0x0f; + + $self->track->car($car)->set_throttle($throttle); + $self->track->car($car)->set_light($light); + $self->track->car($car)->set_backbutton($backbutton); + } + + return $msg; +} + 1;