From: Jan "Yenya" Kasprzak Date: Sun, 13 Feb 2011 11:08:50 +0000 (+0100) Subject: Make the main app use SCX::Parser X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?p=slotcarman.git;a=commitdiff_plain;h=113a957a90fa08bd75eb5f2d48b529bcc1eb860c Make the main app use SCX::Parser --- diff --git a/SCX/RaceParser.pm b/SCX/RaceParser.pm new file mode 100644 index 0000000..51f0676 --- /dev/null +++ b/SCX/RaceParser.pm @@ -0,0 +1,136 @@ +#!/usr/bin/perl -w + +package SCX::RaceParser; + +use strict; + +use IO::File; +use FileHandle; + +use base qw(SCX::Parser); + +our $LOG_FILE_LIMIT = 10_000_000; # bytes + +sub new { + my ($class, $args) = @_; + + my $self = SCX::Parser->new(); + + $self->{track} = $args->{track} + or die "Track argument not given"; + $self->{logfile} = $args->{logfile}; + + if ($self->{logfile}) { + open my $fh, '>>', $self->{logfile} + or die "Can't open $self->{logfile}: $!"; + $self->{logfh} = $fh; + } + + bless $self, $class; + + return $self; +} + +sub log_print { + my ($self, @data) = @_; + + my $size = $self->{logfh}->tell; + + if ($size >= $LOG_FILE_LIMIT) { + close $self->{logfh}; + my $gen = 8; + while ($gen) { + rename $self->{logfile} . '.' . $gen . '.bz2', + $self->{logfile} . '.' . $gen+1 . '.bz2'; + $gen--; + } + + rename $self->{logfile}, $self->{logfile} . '.1'; + system 'bzip2 -9 ' . $self->{logfile} . '.1 &'; + + open my $fh, '>', $self->{logfile} + or die "Can't open $self->{logfile}: $!"; + $self->{logfh} = $fh; + } + + $self->{logfh}->print(sprintf('% 10.3f ', $self->now), + join(' ', map { sprintf('%02X', $_) } @data), "\n"); + $self->{logfh}->flush; +} + +sub log_packet { + my ($self, @data) = @_; + + $self->track->packet_received($self->now); + + $self->log_print(@data) + if $self->{logfile}; +} + +sub bad_bytes { + my ($self, @data) = @_; + + $self->log_print(@data) + if $self->{logfile}; +} + +sub track { return shift->{track} } + +sub race_setup { + my ($self, $rounds) = @_; + + $self->track->race_setup($rounds, $self->now); +} + +sub fuel_level { + my ($self, @fuel) = @_; + + for my $car (0..5) { + $self->track->car($car)->set_fuel($fuel[$car]); + } +} + +sub qualification { + my ($self, $rounds, $cars) = @_; + + $self->track->qualification_setup($rounds, $cars, $self->now); +} + +sub end_of_race { + my ($self) = @_; + + $self->track->race_end; +} + +sub race_start { + my ($self) = @_; + + $self->track->race_start($self->now); +} + +sub finish_line { + my ($self, $regular, @cars_finished) = @_; + + $self->track->finish_line( + $self->now, + $regular, + @cars_finished + ); +} + +sub controller_status { + my ($self, @controllers) = @_; + + for my $car (0..5) { + my $c = $controllers[$car]; + $self->track->car($car)->set_throttle( + $c->{throttle}, + $c->{button}, + $self->now + ); + $self->track->car($car)->set_light($c->{light}); + } +} + +1; + diff --git a/SCX/Reader.pm b/SCX/Reader.pm index 0106476..10ab731 100644 --- a/SCX/Reader.pm +++ b/SCX/Reader.pm @@ -4,43 +4,40 @@ package SCX::Reader; use strict; -use Time::HiRes qw(gettimeofday tv_interval); -use FileHandle; -use IO::Handle; -use POSIX; -use SCX::CRC; +use Time::HiRes qw(time); +use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK O_RDONLY); our $PACKET_SIZE = 9; # 9 bytes + 0x05 -our $LOG_FILE_LIMIT = 10_000_000; # bytes sub new { my ($class, $args) = @_; - my $portname = $args->{portname} - or die "portname not specified"; + my $filename = $args->{filename} + or die "filename not specified"; - system 'stty', '-F', $portname, '115200', 'raw'; - if ($?) { - die "stty died with code $? (no permissions?)"; - } - - sysopen(my $fh, $portname, O_RDONLY|O_NONBLOCK) - or die "Can't open $portname: $!"; - - my $logfile = $args->{logfile}; - my $log_gen = 0; + my $parser = $args->{parser} + or die "parser not specified"; + + my $fh; + + if ($filename eq '-') { + open($fh, '<&=STDIN'); + my $flags = fcntl($fh, F_GETFL, 0); + fcntl($fh, F_SETFL, $flags | O_NONBLOCK); + } else { + system 'stty', '-F', $filename, '115200', 'raw'; + if ($?) { + die "stty died with code $? (no permissions?)"; + } - open my $logfh, '>', "$logfile.$log_gen" - or die "Can't open $logfile.$log_gen: $!"; + sysopen($fh, $filename, O_RDONLY|O_NONBLOCK) + or die "Can't open $filename: $!"; + } my $self = { - portname => $portname, + filename => $filename, fh => $fh, - logfile => $logfile, - logfh => $logfh, - log_gen => $log_gen, - track => $args->{track}, - bytes => [], + parser => $parser, }; bless $self, $class; @@ -50,404 +47,19 @@ sub new { sub fh { return shift->{fh}; } -sub track { return shift->{track}; } - sub read { my ($self) = @_; my $data; my $bytes_read = sysread $self->fh, $data, $PACKET_SIZE; - die "Read error on $self->{portname}: $!" + die "Read error on $self->{filename}: $!" if !$bytes_read; - $self->{last_read_time} = gettimeofday; + my $now = time; my @bytes = unpack("C*", $data); - # print join(' ', map { sprintf(" %02x", $_) } @bytes), "\n"; - 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->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->{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 : ''; - - $self->log_print((map { sprintf("%02x", $_) } @$bytes), $msg); -} - -sub log_cmd { - my ($self, @args) = @_; - - $self->log_print('cmd', @args); -} - -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; # No need to handle this -} - -sub reset_packet { - my ($self, @bytes) = @_; - - my $msg = 'Strange reset packet' - if $bytes[0] != 0xFF - || $bytes[3] != 0xAA - || $bytes[4] != 0xAA - || $bytes[5] != 0xAA; - - $self->log_cmd('reset'); - $self->track->reset; - - return $msg; -} - -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; # We do internal standings handling -} - -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; - - 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; - - 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[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, - ); - - $self->log_cmd('fuel', @fuel); - 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] > 6 - || $bytes[4] != 0xFF - || $bytes[5] != 0xFF; - - 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; -} - - -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; - - $self->log_cmd('race_end'); - $self->track->race_end; - - return $msg; -} - - -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; - - $self->log_cmd('race_start'); - $self->track->race_start($self->{last_read_time}); - - return $msg; -} - - -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; - - 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 - } - - my $msg = 'Strange controller_status packet' - if $fail; - - my @log_data; - - for my $car (0..5) { - my $byte = $bytes[$car]; - - if ($byte == 0xAA) { - $self->track->car($car)->set_throttle(undef, undef, - $self->{last_read_time}); - push @log_data, 'undef', '0'; - next; - } - - my $light = !($byte & 0x20); - my $backbutton = !($byte & 0x10); - my $throttle = $byte & 0x0f; - - 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; + $self->{parser}->add_data($now, @bytes); } 1; diff --git a/SCX/Track.pm b/SCX/Track.pm index 6c4b644..c88e6f8 100644 --- a/SCX/Track.pm +++ b/SCX/Track.pm @@ -5,7 +5,6 @@ package SCX::Track; use strict; use Carp; -use Time::HiRes qw(gettimeofday); use Glib qw(TRUE FALSE); use SCX::Car; @@ -75,7 +74,7 @@ sub semaphore_step { Glib::Timeout->add($timeout, \&semaphore_step, $self); } elsif ($self->{semaphore} == 6) { $self->{race_running} = 1; - $self->{race_running_since} = gettimeofday; + $self->{race_running_since} = $self->{now}; $self->{start_in_progress} = undef; $self->{gui}->show_semaphore(0); Glib::Timeout->add($SEMAPHORE_STEP, \&semaphore_step, $self); diff --git a/gui.pl b/gui.pl index c632a8c..7cfe608 100755 --- a/gui.pl +++ b/gui.pl @@ -9,16 +9,28 @@ use Glib qw(TRUE FALSE); use SCX::GUI; use SCX::Track; use SCX::Reader; +use SCX::RaceParser; my $gui = SCX::GUI->new({ img_height => 120 }); my $track = SCX::Track->new({ gui => $gui }); -my $reader; -eval { - $reader = SCX::Reader->new({ - portname => '/dev/ttyUSB0', - logfile => 'log', - track => $track, +my $logfile = 'log'; +my $tty = '/dev/ttyUSB0'; + +if (defined $ARGV[0] && $ARGV[0] eq '-') { + $logfile = undef; + $tty = '-'; +} + +my $parser = SCX::RaceParser->new({ + track => $track, + logfile => $logfile, +}); + +my $reader = eval { + SCX::Reader->new({ + filename => $tty, + parser => $parser, }); };