X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?a=blobdiff_plain;f=SCX%2FReader.pm;h=010647648b3d5e7e94383f2be529eb085153ee9c;hb=be20fd2ec154ea3fe7fbb3af3357062c09f1ad10;hp=ea012b49ce1e2dfbf9354797028505fedd813930;hpb=e22f8cbb94df063c77cc9ee5f5bae839e252777d;p=slotcarman.git diff --git a/SCX/Reader.pm b/SCX/Reader.pm index ea012b4..0106476 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 = 9; # 9 bytes + 0x05 -our $LOG_ROTATE = 600; +our $LOG_FILE_LIMIT = 10_000_000; # bytes 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}; @@ -32,17 +33,13 @@ sub new { open my $logfh, '>', "$logfile.$log_gen" or die "Can't open $logfile.$log_gen: $!"; - my $now = gettimeofday; - my $self = { portname => $portname, - fh => $tty, + fh => $fh, logfile => $logfile, logfh => $logfh, log_gen => $log_gen, - log_start => $now, - starttime => $now, - track => $track, + track => $args->{track}, bytes => [], }; @@ -53,6 +50,8 @@ sub new { sub fh { return shift->{fh}; } +sub track { return shift->{track}; } + sub read { my ($self) = @_; @@ -61,8 +60,11 @@ sub read { die "Read error on $self->{portname}: $!" if !$bytes_read; + $self->{last_read_time} = gettimeofday; + my @bytes = unpack("C*", $data); + # print join(' ', map { sprintf(" %02x", $_) } @bytes), "\n"; push @{ $self->{bytes} }, @bytes; @bytes = @{ $self->{bytes} }; @@ -88,35 +90,53 @@ sub read { } my @packet = splice @bytes, 0, $PACKET_SIZE+1; - my $rv = &{ $self->{callback} }(@packet); - $self->log_bytes(@packet, $rv); + my $rv = $self->handle_packet(@packet); + $self->log_bytes(\@packet, $rv); + $self->track->packet_received($self->{last_read_time}); + } + + if (@bad_bytes) { + while (@bytes && $bytes[0] != 0x55) { + push @bad_bytes, shift @bytes; + } + $self->log_bytes(\@bad_bytes, "cannot parse packet"); } - $self->log_bad_bytes(\@bad_bytes, "Cannot parse packet"); @{ $self->{bytes} } = @bytes; } +sub log_print { + my ($self, @data) = @_; + + my $size = $self->{logfh}->tell; + + if ($size >= $LOG_FILE_LIMIT) { + 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->{logfh}->print(sprintf('% 10.3f ', $self->{last_read_time}), + join(' ', @data, "\n")); + $self->{logfh}->flush; +} + sub log_bytes { my ($self, $bytes, $msg) = @_; return if !@$bytes; - $msg = defined $msg ? ' # ' . $msg : ''; + $msg = defined $msg ? '# ' . $msg : ''; - my $now = gettimeofday; + $self->log_print((map { sprintf("%02x", $_) } @$bytes), $msg); +} - 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; - } +sub log_cmd { + my ($self, @args) = @_; - $self->{logfh}->print(sprintf('% 10.3f', $now - $self->{starttime}), - (map { sprintf(" %02x", $_) } @$bytes), - $msg, "\n"); + $self->log_print('cmd', @args); } our %COMMANDS = ( @@ -140,7 +160,7 @@ sub handle_packet { my ($self, @data) = @_; my $cmd = $data[1]; - my @args = $data[2..7]; + my @args = @data[2..7]; my $sub = $COMMANDS{$cmd}; return "Unknown packet" @@ -165,14 +185,14 @@ sub car_programming_packet { my ($self, @bytes) = @_; my $msg = 'Strange car programming packet' - if $bytes[0] & 0xF8 != 0 || $bytes[0] & 0x07 > 5 + 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; + return $msg; # No need to handle this } sub reset_packet { @@ -184,21 +204,28 @@ sub reset_packet { || $bytes[4] != 0xAA || $bytes[5] != 0xAA; - return $msg; # FIXME - to be implemented + $self->log_cmd('reset'); + $self->track->reset; + + return $msg; } 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; + 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); - return $msg; # FIXME - to be implemented + my @standings; + + push @standings, map { $_ != 0xFF ? $_ & (0x07) : () } @bytes; + + return $msg; # We do internal standings handling } sub lap_time_packet { @@ -208,14 +235,13 @@ sub lap_time_packet { if $bytes[0] > 5 || $bytes[1] & 0x01 || $bytes[2] & 0x01 - || $bytes[3] & 0xF8 != 0 + || ($bytes[3] & 0xF0) != 0 || $bytes[4] & 0x01 || $bytes[5] & 0x01; - return $msg; # FIXME - to be implemented + return $msg; } - sub race_setup_packet { my ($self, @bytes) = @_; @@ -227,30 +253,39 @@ sub race_setup_packet { || $bytes[4] != 0xFF || $bytes[5] != 0xFF; - return $msg; # FIXME - to be implemented -} + my $rounds = $bytes[0] == 0x00 + ? 0 + : ($bytes[1] & 0x0F) * 256 + + ($bytes[2] & 0x0F) * 16 + + ($bytes[3] & 0x0F); + + $self->log_cmd('race_setup', $rounds); + $self->track->race_setup($rounds, $self->{last_read_time}); + return $msg; +} sub fuel_level_packet { my ($self, @bytes) = @_; my $msg = 'Strange fuel_level packet' if ($bytes[0] >> 4) > 8 - || $bytes[0] & 0x0F > 8 + || ($bytes[0] & 0x0F) > 8 || ($bytes[1] >> 4) > 8 - || $bytes[1] & 0x0F > 8 + || ($bytes[1] & 0x0F) > 8 || ($bytes[2] >> 4) > 8 - || $bytes[2] & 0x0F > 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, - $bytes[3] >> 4, $bytes[3] & 0x0f, ); + $self->log_cmd('fuel', @fuel); for my $car (0..5) { - $track->car($car)->set_fuel($fuel[$car]); + $self->track->car($car)->set_fuel($fuel[$car]); } return $msg; @@ -271,11 +306,19 @@ sub qualification_packet { if $bytes[0] & 0xF0 || $bytes[1] & 0xF0 || $bytes[2] & 0xF0 - || $bytes[3] > 5 + || $bytes[3] > 6 || $bytes[4] != 0xFF || $bytes[5] != 0xFF; - return $msg; # FIXME - to be implemented + my $rounds = ($bytes[0] & 0x0F) * 256 + + ($bytes[1] & 0x0F) * 16 + + ($bytes[2] & 0x0F); + my $cars = $bytes[3]; + $self->log_cmd('qualification_start', $rounds, $cars); + $self->track->qualification_setup($rounds, $cars, + $self->{last_read_time}); + + return $msg; } @@ -290,7 +333,10 @@ sub end_of_race_packet { || $bytes[4] != 0xFF || $bytes[5] != 0xFF; - return $msg; # FIXME - to be implemented + $self->log_cmd('race_end'); + $self->track->race_end; + + return $msg; } @@ -305,7 +351,10 @@ sub race_start_packet { || $bytes[4] != 0xAA || $bytes[5] != 0xAA; - return $msg; # FIXME - to be implemented + $self->log_cmd('race_start'); + $self->track->race_start($self->{last_read_time}); + + return $msg; } @@ -339,34 +388,50 @@ sub finish_line_packet { my $msg = 'Strange finish_line packet' if $fail; - return $msg; # FIXME - to be implemented -} + my $regular = 1; + my @cars_finished; + for my $i (0..5) { + my $byte = $bytes[$i]; + + $regular = 0 + if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE; + push @cars_finished, $i if $byte == 0xE7; + } + + $self->log_cmd('finish_line', $regular, @cars_finished); + $self->track->finish_line( + $self->{last_read_time}, + $regular, + @cars_finished + ); + + return $msg; +} sub controller_status_packet { my ($self, @bytes) = @_; my $fail; for my $byte (@bytes) { + next if $byte == 0xAA; $fail = 1 - if $byte & 0xC0 != 0xC0 - || $byte & 0x0F > 12 + 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, - ); + my @log_data; for my $car (0..5) { my $byte = $bytes[$car]; if ($byte == 0xAA) { - $track->car($car)->set_throttle(undef); + $self->track->car($car)->set_throttle(undef, undef, + $self->{last_read_time}); + push @log_data, 'undef', '0'; next; } @@ -374,11 +439,14 @@ sub controller_status_packet { 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); + push @log_data, $throttle, $backbutton ? 1 : 0; + $self->track->car($car)->set_throttle($throttle, $backbutton, + $self->{last_read_time}); + $self->track->car($car)->set_light($light); } + $self->log_cmd('throttle', @log_data); + return $msg; }